Fix locale case-ignorant matching bug reported in

To: perl5-porters@perl.org
Subject: [ID 20000223.005]
Message-Id: <20000223160308.1830.qmail@md.media-web.de>

p4raw-id: //depot/cfgperl@5277

diff --git a/regexec.c b/regexec.c
index c65624b..4775e49 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -781,9 +781,9 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
 {
        I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
        char *m;
-       int ln;
-       int c1;
-       int c2;
+       STRLEN ln;
+       unsigned int c1;
+       unsigned int c2;
        char *e;
        register I32 tmp = 1;   /* Scratch variable? */
 
@@ -804,7 +804,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
            break;
        case ANYOF:
            while (s < strend) {
-               if (REGINCLASS(c, *s)) {
+               if (REGINCLASS(c, *(U8*)s)) {
                    if (tmp && (norun || regtry(prog, s)))
                        goto got_it;
                    else
@@ -818,13 +818,13 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
        case EXACTF:
            m = STRING(c);
            ln = STR_LEN(c);
-           c1 = *m;
+           c1 = *(U8*)m;
            c2 = PL_fold[c1];
            goto do_exactf;
        case EXACTFL:
            m = STRING(c);
            ln = STR_LEN(c);
-           c1 = *m;
+           c1 = *(U8*)m;
            c2 = PL_fold_locale[c1];
          do_exactf:
            e = strend - ln;
@@ -834,7 +834,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
            /* Here it is NOT UTF!  */
            if (c1 == c2) {
                while (s <= e) {
-                   if ( *s == c1
+                   if ( *(U8*)s == c1
                         && (ln == 1 || !(OP(c) == EXACTF
                                          ? ibcmp(s, m, ln)
                                          : ibcmp_locale(s, m, ln)))
@@ -844,7 +844,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
                }
            } else {
                while (s <= e) {
-                   if ( (*s == c1 || *s == c2)
+                   if ( (*(U8*)s == c1 || *(U8*)s == c2)
                         && (ln == 1 || !(OP(c) == EXACTF
                                          ? ibcmp(s, m, ln)
                                          : ibcmp_locale(s, m, ln)))

diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index 7642678..6265cce 100755 (executable)
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -34,7 +34,7 @@ eval {
 # and mingw32 uses said silly CRT
 $have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i;
 
-print "1..", ($have_setlocale ? 115 : 98), "\n";
+print "1..", ($have_setlocale ? 116 : 98), "\n";
 
 use vars qw(&LC_ALL);
 
@@ -388,6 +388,7 @@ my %Problem;
 my %Okay;
 my %Testing;
 my @Neoalpha;
+my %Neoalpha;
 
 sub tryneoalpha {
     my ($Locale, $i, $test) = @_;
@@ -451,6 +452,7 @@ foreach $Locale (@Locale) {
        @Neoalpha = ();
        for (keys %UPPER, keys %lower) {
            push(@Neoalpha, $_) if (/\W/);
+           $Neoalpha{$_} = $_;
        }
     }
 
@@ -642,11 +644,31 @@ foreach $Locale (@Locale) {
                    lcA($x, $y) == 1 && lcB($x, $y) == 1 ||
                    lcA($x, $z) == 0 && lcB($x, $z) == 0);
     }
+
+    debug "# testing 116 with locale '$Locale'\n";
+    {
+       use locale;
+
+       my @f = ();
+       foreach my $x (keys %UPPER) {
+           my $y = lc $x;
+           next unless uc $y eq $x;
+           push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
+       }
+       foreach my $x (keys %lower) {
+           my $y = uc $x;
+           next unless lc $y eq $x;
+           push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
+       }
+       tryneoalpha($Locale, 116, @f == 0);
+       print "# testing 116 failed for locale '$Locale' for characters @f\n"
+            if @f;
+    }
 }
 
 # Recount the errors.
 
-foreach (99..115) {
+foreach (99..116) {
     if ($Problem{$_} || !defined $Okay{$_} || !@{$Okay{$_}}) {
        if ($_ == 102) {
            print "# The failure of test 102 is not necessarily fatal.\n";
@@ -662,7 +684,7 @@ foreach (99..115) {
 
 my $didwarn = 0;
 
-foreach (99..115) {
+foreach (99..116) {
     if ($Problem{$_}) {
        my @f = sort keys %{ $Problem{$_} };
        my $f = join(" ", @f);