diff options
Diffstat (limited to 't/pragma/locale.t')
| -rwxr-xr-x | t/pragma/locale.t | 138 |
1 files changed, 100 insertions, 38 deletions
diff --git a/t/pragma/locale.t b/t/pragma/locale.t index c8a0df8724..61528b35c3 100755 --- a/t/pragma/locale.t +++ b/t/pragma/locale.t @@ -34,7 +34,9 @@ eval { # 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); @@ -242,13 +244,13 @@ Afrikaans:af:za:1 15 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 @@ -271,11 +273,12 @@ Latvian:lv:lv:4 6 13 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 @@ -283,10 +286,11 @@ Sqhip Albanian:sq:sq:1 15 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//; } @@ -326,6 +330,7 @@ sub decode_encodings { } } else { push @enc, $_; + push @enc, "$_.UTF-8"; } } if ($^O eq 'os390') { @@ -347,32 +352,61 @@ foreach (0..15) { 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"); + } } } } @@ -380,6 +414,8 @@ foreach my $locale (split(/\n/, $locales)) { setlocale(LC_ALL, "C"); +sub utf8locale { $_[0] =~ /utf-?8/i } + @Locale = sort @Locale; debug "# Locales = @Locale\n"; @@ -470,7 +506,10 @@ foreach $Locale (@Locale) { # Test \w. - { + if (utf8locale($Locale)) { + # Until the polymorphic regexen arrive. + debug "# skipping UTF-8 locale '$Locale'\n"; + } else { my $word = join('', @Neoalpha); $word =~ /^(\w+)$/; @@ -623,6 +662,9 @@ foreach $Locale (@Locale) { } 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; @@ -646,7 +688,13 @@ foreach $Locale (@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 = (); @@ -661,15 +709,16 @@ foreach $Locale (@Locale) { 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"; @@ -685,7 +734,7 @@ foreach (99..116) { my $didwarn = 0; -foreach (99..116) { +foreach (99..$last) { if ($Problem{$_}) { my @f = sort keys %{ $Problem{$_} }; my $f = join(" ", @f); @@ -710,17 +759,18 @@ EOW } } -# 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) { @@ -732,7 +782,19 @@ if ($didwarn) { "#\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"; } } |