# and mingw32 uses said silly CRT
$have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i;
-print "1..", ($have_setlocale ? 116 : 98), "\n";
+my $last = $have_setlocale ? 116 : 98;
+
+print "1..$last\n";
use vars qw(&LC_ALL);
Arabic:ar:dz eg sa:6 arabic8
Brezhoneg Breton:br:fr:1 15
Bulgarski Bulgarian:bg:bg:5
-Chinese:zh:cn tw:cn.EUC eucCN eucTW euc.CN euc.TW GB2312 tw.EUC
+Chinese:zh:cn tw:cn.EUC eucCN eucTW euc.CN euc.TW Big5 GB2312 tw.EUC
Hrvatski Croatian:hr:hr:2
Cymraeg Welsh:cy:cy:1 14 15
Czech:cs:cz:2
Dansk Danish:dk:da:1 15
Nederlands Dutch:nl:be nl:1 15
-English American British:en:au ca gb ie nz us uk:1 15 cp850
+English American British:en:au ca gb ie nz us uk zw:1 15 cp850
Esperanto:eo:eo:3
Eesti Estonian:et:ee:4 6 13
Suomi Finnish:fi:fi:1 15
Lithuanian:lt:lt:4 6 13
Macedonian:mk:mk:1 15
Maltese:mt:mt:3
-Norsk Norwegian:no:no:1 15
+Moldovan:mo:mo:2
+Norsk Norwegian:no no\@nynorsk:no:1 15
Occitan:oc:es:1 15
Polski Polish:pl:pl:2
Rumanian:ro:ro:2
-Russki Russian:ru:ru su ua:5 koi8 koi8r koi8u cp1251
+Russki Russian:ru:ru su ua:5 koi8 koi8r KOI8-R koi8u cp1251 cp866
Serbski Serbian:sr:yu:5
Slovak:sk:sk:2
Slovene Slovenian:sl:si:2
Svenska Swedish:sv:fi se:1 15
Thai:th:th:11 tis620
Turkish:tr:tr:9 turkish8
-Yiddish:::1 15
+Yiddish:yi::1 15
EOF
if ($^O eq 'os390') {
+ # These cause heartburn. Broken locales?
$locales =~ s/Svenska Swedish:sv:fi se:1 15\n//;
$locales =~ s/Thai:th:th:11 tis620\n//;
}
}
} else {
push @enc, $_;
+ push @enc, "$_.UTF-8";
}
}
if ($^O eq 'os390') {
trylocale("iso_latin_$_");
}
-foreach my $locale (split(/\n/, $locales)) {
- my ($locale_name, $language_codes, $country_codes, $encodings) =
- split(/:/, $locale);
- my @enc = decode_encodings($encodings);
- foreach my $loc (split(/ /, $locale_name)) {
- trylocale($loc);
- foreach my $enc (@enc) {
- trylocale("$loc.$enc");
- }
- $loc = lc $loc;
- foreach my $enc (@enc) {
- trylocale("$loc.$enc");
- }
+# Sanitize the environment so that we can run the external 'locale'
+# program without the taint mode getting grumpy.
+
+# $ENV{PATH} is special in VMS.
+delete $ENV{PATH} if $^O ne 'VMS' or $Config{d_setenv};
+
+# Other subversive stuff.
+delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
+
+if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) {
+ while (<LOCALES>) {
+ chomp;
+ trylocale($_);
}
- foreach my $lang (split(/ /, $language_codes)) {
- trylocale($lang);
- foreach my $country (split(/ /, $country_codes)) {
- my $lc = "${lang}_${country}";
- trylocale($lc);
+ close(LOCALES);
+} elsif ($^O eq 'VMS' && defined($ENV{'SYS$I18N_LOCALE'}) && -d 'SYS$I18N_LOCALE') {
+# The SYS$I18N_LOCALE logical name search list was not present on
+# VAX VMS V5.5-12, but was on AXP && VAX VMS V6.2 as well as later versions.
+ opendir(LOCALES, "SYS\$I18N_LOCALE:");
+ while ($_ = readdir(LOCALES)) {
+ chomp;
+ trylocale($_);
+ }
+ close(LOCALES);
+} else {
+
+ # This is going to be slow.
+
+ foreach my $locale (split(/\n/, $locales)) {
+ my ($locale_name, $language_codes, $country_codes, $encodings) =
+ split(/:/, $locale);
+ my @enc = decode_encodings($encodings);
+ foreach my $loc (split(/ /, $locale_name)) {
+ trylocale($loc);
foreach my $enc (@enc) {
- trylocale("$lc.$enc");
+ trylocale("$loc.$enc");
}
- my $lC = "${lang}_\U${country}";
- trylocale($lC);
+ $loc = lc $loc;
foreach my $enc (@enc) {
- trylocale("$lC.$enc");
+ trylocale("$loc.$enc");
+ }
+ }
+ foreach my $lang (split(/ /, $language_codes)) {
+ trylocale($lang);
+ foreach my $country (split(/ /, $country_codes)) {
+ my $lc = "${lang}_${country}";
+ trylocale($lc);
+ foreach my $enc (@enc) {
+ trylocale("$lc.$enc");
+ }
+ my $lC = "${lang}_\U${country}";
+ trylocale($lC);
+ foreach my $enc (@enc) {
+ trylocale("$lC.$enc");
+ }
}
}
}
setlocale(LC_ALL, "C");
+sub utf8locale { $_[0] =~ /utf-?8/i }
+
@Locale = sort @Locale;
debug "# Locales = @Locale\n";
# Test \w.
- {
+ if (utf8locale($Locale)) {
+ # Until the polymorphic regexen arrive.
+ debug "# skipping UTF-8 locale '$Locale'\n";
+ } else {
my $word = join('', @Neoalpha);
$word =~ /^(\w+)$/;
}
debug "# testing 115 with locale '$Locale'\n";
+ # Does taking lc separately differ from taking
+ # the lc "in-line"? (This was the bug 19990704.002, change #3568.)
+ # The bug was in the caching of the 'o'-magic.
{
use locale;
}
debug "# testing 116 with locale '$Locale'\n";
- {
+ # Does lc of an UPPER (if different from the UPPER) match
+ # case-insensitively the UPPER, and does the UPPER match
+ # case-insensitively the lc of the UPPER. And vice versa.
+ if (utf8locale($Locale)) {
+ # Until the polymorphic regexen arrive.
+ debug "# skipping UTF-8 locale '$Locale'\n";
+ } else {
use locale;
my @f = ();
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;
+ if (@f) {
+ print "# failed 116 locale '$Locale' characters @f\n"
+ }
}
}
# Recount the errors.
-foreach (99..116) {
+foreach (99..$last) {
if ($Problem{$_} || !defined $Okay{$_} || !@{$Okay{$_}}) {
if ($_ == 102) {
print "# The failure of test 102 is not necessarily fatal.\n";
my $didwarn = 0;
-foreach (99..116) {
+foreach (99..$last) {
if ($Problem{$_}) {
my @f = sort keys %{ $Problem{$_} };
my $f = join(" ", @f);
}
}
-# Tell which locales were okay.
+# Tell which locales were okay and which were not.
if ($didwarn) {
- my @s;
+ my (@s, @F);
foreach my $l (@Locale) {
my $p = 0;
- foreach my $t (102..116) {
+ foreach my $t (102..$last) {
$p++ if $Problem{$t}{$l};
}
push @s, $l if $p == 0;
+ push @F, $l unless $p == 0;
}
if (@s) {
"#\t", $s, "\n#\n",
"# tested okay.\n#\n",
} else {
- warn "# None of your locales was fully okay.\n";
+ warn "# None of your locales were fully okay.\n";
+ }
+
+ if (@F) {
+ my $F = join(" ", @F);
+ $F =~ s/(.{50,60}) /$1\n#\t/g;
+
+ warn
+ "# The following locales\n#\n",
+ "#\t", $F, "\n#\n",
+ "# had problems.\n#\n",
+ } else {
+ warn "# None of your locales were broken.\n";
}
}
projects / p5sagit/p5-mst-13.2.git / blobdiff