Change 13866 by jhi@alpha on 2001/12/23 16:43:29
The funky final sigma casefolding.
Affected files ...
.... //depot/perl/regcomp.c#260 edit
.... //depot/perl/regexec.c#221 edit
.... //depot/perl/t/op/pat.t#139 edit
.... //depot/perl/utf8.h#47 edit
Differences ...
==== //depot/perl/regcomp.c#260 (text) ====
Index: perl/regcomp.c
--- perl/regcomp.c.~1~ Sun Dec 23 10:00:05 2001
+++ perl/regcomp.c Sun Dec 23 10:00:05 2001
@@ -3981,9 +3981,21 @@
if (prevvalue < value)
Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n",
(UV)prevvalue, (UV)value);
- else if (prevvalue == value)
+ else if (prevvalue == value) {
Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n",
(UV)value);
+ if (FOLD) {
+ if (value == UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA) {
+ Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n",
+ UNICODE_GREEK_CAPITAL_LETTER_SIGMA);
+ Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n",
+ UNICODE_GREEK_SMALL_LETTER_SIGMA);
+ }
+ else if (value == UNICODE_GREEK_CAPITAL_LETTER_SIGMA)
+ Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n",
+ UNICODE_GREEK_SMALL_LETTER_SIGMA);
+ }
+ }
}
}
==== //depot/perl/regexec.c#221 (text) ====
Index: perl/regexec.c
--- perl/regexec.c.~1~ Sun Dec 23 10:00:05 2001
+++ perl/regexec.c Sun Dec 23 10:00:05 2001
@@ -975,7 +975,7 @@
* Fortunately, not getting this right is allowed
* for Unicode Regular Expression Support level 1,
* only one-to-one matching is required. --jhi */
- if (c1 == c2)
+ if (c1 == c2) {
while (s <= e) {
if ( utf8_to_uvchr((U8*)s, &len) == c1
&& (ln == len ||
@@ -985,9 +985,13 @@
goto got_it;
s += len;
}
- else
+ }
+ else {
while (s <= e) {
UV c = utf8_to_uvchr((U8*)s, &len);
+ if (c == UNICODE_GREEK_CAPITAL_LETTER_SIGMA ||
+ c == UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
+ c = UNICODE_GREEK_SMALL_LETTER_SIGMA;
if ( (c == c1 || c == c2)
&& (ln == len ||
ibcmp_utf8(s, do_utf8, strend - s,
@@ -996,6 +1000,7 @@
goto got_it;
s += len;
}
+ }
}
else {
if (c1 == c2)
==== //depot/perl/t/op/pat.t#139 (xtext) ====
Index: perl/t/op/pat.t
--- perl/t/op/pat.t.~1~ Sun Dec 23 10:00:05 2001
+++ perl/t/op/pat.t Sun Dec 23 10:00:05 2001
@@ -6,7 +6,7 @@
$| = 1;
-print "1..794\n";
+print "1..812\n";
BEGIN {
chdir 't' if -d 't';
@@ -2418,3 +2418,35 @@
print "!abc!" =~ /a\Cc/ ? "ok 793\n" : "not ok 793\n";
print "!abc!" =~ /a\Xc/ ? "ok 794\n" : "not ok 794\n";
}
+
+{
+ print "# FINAL SIGMA\n";
+
+ my $SIGMA = "\x{03A3}"; # CAPITAL
+ my $Sigma = "\x{03C2}"; # SMALL FINAL
+ my $sigma = "\x{03C3}"; # SMALL
+
+ print $SIGMA =~ /$SIGMA/i ? "ok 795\n" : "not ok 795\n";
+ print $SIGMA =~ /$Sigma/i ? "ok 796\n" : "not ok 796\n";
+ print $SIGMA =~ /$sigma/i ? "ok 797\n" : "not ok 797\n";
+
+ print $Sigma =~ /$SIGMA/i ? "ok 798\n" : "not ok 798\n";
+ print $Sigma =~ /$Sigma/i ? "ok 799\n" : "not ok 799\n";
+ print $Sigma =~ /$sigma/i ? "ok 800\n" : "not ok 800\n";
+
+ print $sigma =~ /$SIGMA/i ? "ok 801\n" : "not ok 801\n";
+ print $sigma =~ /$Sigma/i ? "ok 802\n" : "not ok 802\n";
+ print $sigma =~ /$sigma/i ? "ok 803\n" : "not ok 803\n";
+
+ print $SIGMA =~ /[$SIGMA]/i ? "ok 804\n" : "not ok 804\n";
+ print $SIGMA =~ /[$Sigma]/i ? "ok 805\n" : "not ok 805\n";
+ print $SIGMA =~ /[$sigma]/i ? "ok 806\n" : "not ok 806\n";
+
+ print $Sigma =~ /[$SIGMA]/i ? "ok 807\n" : "not ok 807\n";
+ print $Sigma =~ /[$Sigma]/i ? "ok 808\n" : "not ok 808\n";
+ print $Sigma =~ /[$sigma]/i ? "ok 809\n" : "not ok 809\n";
+
+ print $sigma =~ /[$SIGMA]/i ? "ok 810\n" : "not ok 810\n";
+ print $sigma =~ /[$Sigma]/i ? "ok 811\n" : "not ok 811\n";
+ print $sigma =~ /[$sigma]/i ? "ok 812\n" : "not ok 812\n";
+}
==== //depot/perl/utf8.h#47 (text) ====
Index: perl/utf8.h
--- perl/utf8.h.~1~ Sun Dec 23 10:00:05 2001
+++ perl/utf8.h Sun Dec 23 10:00:05 2001
@@ -188,3 +188,8 @@
#endif
#define UTF8_IS_ASCII(c) UTF8_IS_INVARIANT(c)
+
+#define UNICODE_GREEK_CAPITAL_LETTER_SIGMA 0x03A3
+#define UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA 0x03C2
+#define UNICODE_GREEK_SMALL_LETTER_SIGMA 0x03C3
+
End of Patch.
