From: gomar@md.media-web.de <gomar@md.media-web.de>
Date: Wed, 23 Feb 2000 16:03:08 +0000 (+0000)
Subject: Fix locale case-ignorant matching bug reported in
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d8093b2375fb3a19a929a3e6a024b10c2f8eb0bd;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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);