sub in_utf8 () { $^H & 0x08 }
if (in_utf8) {
- require "locale/utf8";
+ require "lib/locale/utf8";
} else {
- require "locale/latin1";
+ require "lib/locale/latin1";
}
my @Locale;
$utf8skip{117}++;
} else {
use locale;
- use locale;
- no utf8; # so that the native 8-bit characters work
+ no utf8;
+ my $re = qr/[\[\(\{\*\+\?\|\^\$\\]/;
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;
+ print "# UPPER $x lc $y ",
+ $x =~ /$y/i ? 1 : 0, " ",
+ $y =~ /$x/i ? 1 : 0, "\n" if 0;
+ # If $x and $y contain regular expression characters
+ # AND THEY lowercase (/i) to regular expression characters,
+ # regcomp() will be mightily confused. No, the \Q doesn't
+ # help here (maybe regex engine internal lowercasing
+ # is done after the \Q?) An example of this happening is
+ # the bg_BG (Bulgarian) locale under EBCDIC (OS/390 USS):
+ # the chr(173) (the "[") is the lowercase of the chr(235).
+ # Similarly losing EBCDIC locales include cs_cz, cs_CZ,
+ # el_gr, el_GR, en_us.IBM-037 (!), en_US.IBM-037 (!),
+ # et_ee, et_EE, hr_hr, hr_HR, hu_hu, hu_HU, lt_LT,
+ # mk_mk, mk_MK, nl_nl.IBM-037, nl_NL.IBM-037,
+ # pl_pl, pl_PL, ro_ro, ro_RO, ru_ru, ru_RU,
+ # sk_sk, sk_SK, sl_si, sl_SI, tr_tr, tr_TR.
+ if ($x =~ $re || $y =~ $re) {
+ print "# Regex characters in '$x' or '$y', skipping test 117 for locale '$Locale'\n";
+ next;
+ }
+ # With utf8 both will fail since the locale concept
+ # of upper/lower does not work well in Unicode.
+ 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;
+ print "# lower $x uc $y ",
+ $x =~ /$y/i ? 1 : 0, " ",
+ $y =~ /$x/i ? 1 : 0, "\n" if 0;
+ if ($x =~ $re || $y =~ $re) { # See above.
+ print "# Regex characters in '$x' or '$y', skipping test 117 for locale '$Locale'\n";
+ next;
+ }
+ # With utf8 both will fail since the locale concept
+ # of upper/lower does not work well in Unicode.
+ push @f, $x unless $x =~ /$y/i == $y =~ /$x/i;
}
tryneoalpha($Locale, 117, @f == 0);
if (@f) {