Change 13332 by jhi@alpha on 2001/11/28 03:23:04
Fix for "a\x{100}" =~ /A/i.
Affected files ...
.... //depot/perl/embed.h#310 edit
.... //depot/perl/embed.pl#298 edit
.... //depot/perl/global.sym#189 edit
.... //depot/perl/proto.h#352 edit
.... //depot/perl/regexec.c#208 edit
.... //depot/perl/t/op/pat.t#131 edit
.... //depot/perl/utf8.c#116 edit
Differences ...
==== //depot/perl/embed.h#310 (text+w) ====
Index: perl/embed.h
--- perl/embed.h.~1~ Tue Nov 27 20:30:05 2001
+++ perl/embed.h Tue Nov 27 20:30:05 2001
@@ -261,6 +261,7 @@
#define hv_undef Perl_hv_undef
#define ibcmp Perl_ibcmp
#define ibcmp_locale Perl_ibcmp_locale
+#define ibcmp_utf8 Perl_ibcmp_utf8
#define ingroup Perl_ingroup
#define init_argv_symbols Perl_init_argv_symbols
#define init_debugger Perl_init_debugger
@@ -1780,6 +1781,7 @@
#define hv_undef(a) Perl_hv_undef(aTHX_ a)
#define ibcmp(a,b,c) Perl_ibcmp(aTHX_ a,b,c)
#define ibcmp_locale(a,b,c) Perl_ibcmp_locale(aTHX_ a,b,c)
+#define ibcmp_utf8(a,b,c,d,e) Perl_ibcmp_utf8(aTHX_ a,b,c,d,e)
#define ingroup(a,b) Perl_ingroup(aTHX_ a,b)
#define init_argv_symbols(a,b) Perl_init_argv_symbols(aTHX_ a,b)
#define init_debugger() Perl_init_debugger(aTHX)
==== //depot/perl/embed.pl#298 (xtext) ====
Index: perl/embed.pl
--- perl/embed.pl.~1~ Tue Nov 27 20:30:05 2001
+++ perl/embed.pl Tue Nov 27 20:30:05 2001
@@ -1333,6 +1333,7 @@
Apd |void |hv_undef |HV* tb
Ap |I32 |ibcmp |const char* a|const char* b|I32 len
Ap |I32 |ibcmp_locale |const char* a|const char* b|I32 len
+Ap |I32 |ibcmp_utf8 |const char* a|bool ua|const char* b|bool ub|I32 len
p |bool |ingroup |Gid_t testgid|Uid_t effective
p |void |init_argv_symbols|int|char **
p |void |init_debugger
==== //depot/perl/global.sym#189 (text+w) ====
Index: perl/global.sym
--- perl/global.sym.~1~ Tue Nov 27 20:30:05 2001
+++ perl/global.sym Tue Nov 27 20:30:05 2001
@@ -153,6 +153,7 @@
Perl_hv_undef
Perl_ibcmp
Perl_ibcmp_locale
+Perl_ibcmp_utf8
Perl_init_stacks
Perl_init_tm
Perl_instr
==== //depot/perl/proto.h#352 (text+w) ====
Index: perl/proto.h
--- perl/proto.h.~1~ Tue Nov 27 20:30:05 2001
+++ perl/proto.h Tue Nov 27 20:30:05 2001
@@ -315,6 +315,7 @@
PERL_CALLCONV void Perl_hv_undef(pTHX_ HV* tb);
PERL_CALLCONV I32 Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len);
PERL_CALLCONV I32 Perl_ibcmp_locale(pTHX_ const char* a, const char* b, I32 len);
+PERL_CALLCONV I32 Perl_ibcmp_utf8(pTHX_ const char* a, bool ua, const char* b,
+bool ub, I32 len);
PERL_CALLCONV bool Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective);
PERL_CALLCONV void Perl_init_argv_symbols(pTHX_ int, char **);
PERL_CALLCONV void Perl_init_debugger(pTHX);
==== //depot/perl/regexec.c#208 (text) ====
Index: perl/regexec.c
--- perl/regexec.c.~1~ Tue Nov 27 20:30:05 2001
+++ perl/regexec.c Tue Nov 27 20:30:05 2001
@@ -962,14 +962,17 @@
if (c1 == c2)
while (s <= e) {
if ( utf8_to_uvchr((U8*)s, &len) == c1
- && regtry(prog, s) )
+ && (ln == 1 ||
+ ibcmp_utf8(s, do_utf8, m, UTF, ln)) )
goto got_it;
s += len;
}
else
while (s <= e) {
UV c = utf8_to_uvchr((U8*)s, &len);
- if ( (c == c1 || c == c2) && regtry(prog, s) )
+ if ( (c == c1 || c == c2)
+ && (ln == 1 ||
+ ibcmp_utf8(s, do_utf8, m, UTF, ln)) )
goto got_it;
s += len;
}
==== //depot/perl/t/op/pat.t#131 (xtext) ====
Index: perl/t/op/pat.t
--- perl/t/op/pat.t.~1~ Tue Nov 27 20:30:05 2001
+++ perl/t/op/pat.t Tue Nov 27 20:30:05 2001
@@ -6,7 +6,7 @@
$| = 1;
-print "1..753\n";
+print "1..757\n";
BEGIN {
chdir 't' if -d 't';
@@ -2248,6 +2248,8 @@
}
{
+ # Script=, Block=, Category=
+
print "not " unless "\x{0100}" =~ /\p{Script=Latin}/;
print "ok 748\n";
@@ -2259,6 +2261,8 @@
}
{
+ print "# the basic character classes and Unicode \n";
+
# 0100;LATIN CAPITAL LETTER A WITH MACRON;Lu;0;L;0041 0304;;;;N;LATIN CAPITAL
LETTER A MACRON;;;0101;
print "not " unless "\x{0100}" =~ /\w/;
print "ok 751\n";
@@ -2271,3 +2275,19 @@
print "not " unless "\x{1680}" =~ /\s/;
print "ok 753\n";
}
+
+{
+ print "# folding matches and Unicode\n";
+
+ print "not " unless "a\x{100}" =~ /A/i;
+ print "ok 754\n";
+
+ print "not " unless "A\x{100}" =~ /A/i;
+ print "ok 755\n";
+
+ print "not " unless "a\x{100}" =~ /a/i;
+ print "ok 756\n";
+
+ print "not " unless "A\x{100}" =~ /A/i;
+ print "ok 757\n";
+}
==== //depot/perl/utf8.c#116 (text) ====
Index: perl/utf8.c
--- perl/utf8.c.~1~ Tue Nov 27 20:30:05 2001
+++ perl/utf8.c Tue Nov 27 20:30:05 2001
@@ -1543,6 +1543,51 @@
char *
Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
{
- return Perl_pv_uni_display(aTHX_ dsv, (U8*)SvPVX(ssv), SvCUR(ssv),
- pvlim, flags);
+ return Perl_pv_uni_display(aTHX_ dsv, (U8*)SvPVX(ssv), SvCUR(ssv),
+ pvlim, flags);
+}
+
+I32
+Perl_ibcmp_utf8(pTHX_ const char *s1, bool u1, const char *s2, bool u2, register I32
+len)
+{
+ register U8 *a = (U8*)s1;
+ register U8 *b = (U8*)s2;
+ STRLEN la, lb;
+ UV ca, cb;
+ STRLEN ulen1, ulen2;
+ U8 tmpbuf1[UTF8_MAXLEN*3+1];
+ U8 tmpbuf2[UTF8_MAXLEN*3+1];
+
+ while (len) {
+ if (u1)
+ ca = utf8_to_uvchr((U8*)a, &la);
+ else {
+ ca = *a;
+ la = 1;
+ }
+ if (u2)
+ cb = utf8_to_uvchr((U8*)b, &lb);
+ else {
+ cb = *b;
+ lb = 1;
+ }
+ if (ca != cb) {
+ if (u1)
+ to_uni_lower(NATIVE_TO_UNI(ca), tmpbuf1, &ulen1);
+ else
+ ulen1 = 1;
+ if (u2)
+ to_uni_lower(NATIVE_TO_UNI(cb), tmpbuf2, &ulen2);
+ else
+ ulen2 = 1;
+ if (ulen1 != ulen2
+ || (ulen1 == 1 && PL_fold[ca] != PL_fold[cb])
+ || memNE(tmpbuf1, tmpbuf2, ulen1))
+ return 1;
+ }
+ a += la;
+ b += lb;
+ }
+ return 0;
}
+
End of Patch.
