diff options
| -rw-r--r-- | regexec.c | 16 | ||||
| -rwxr-xr-x | t/pragma/locale.t | 28 |
2 files changed, 33 insertions, 11 deletions
@@ -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 76426787ca..6265ccef1f 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); |