In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/31f658ea7702fc70c35f013cc9d18909fd7589c9?hp=66e937f51e083cc757df2a7c292e70ae7ed574bc>
- Log ----------------------------------------------------------------- commit 31f658ea7702fc70c35f013cc9d18909fd7589c9 Author: Karl Williamson <[email protected]> Date: Wed Mar 12 13:06:49 2014 -0600 lib/locale.t: Update $variable name As of commit b057411ddb1a3d8b6ab062d667c8e39f80cd7343, the meaning of the variable is extended to beyond just being about 'folding', so change the name to correspond. M lib/locale.t commit a5cf558aeda18ca1d1203fb44617ec10b564eb12 Author: Karl Williamson <[email protected]> Date: Wed Mar 12 13:03:22 2014 -0600 PATCH: [perl #121340] lib/locale.t noisy+complaining but passes on Win32 It turns out that these messages were not printed as one would expect under TAP, but were output using warn(). M lib/locale.t commit d458c02c88acd3b20dabe5e2c98fa6a9668beee8 Author: Karl Williamson <[email protected]> Date: Wed Mar 12 12:54:45 2014 -0600 lib/locale.t: Fix broken test The test that [:digit:] is a subset of [:xdigit:] failed in locales where [:digit:] matches 2 blocks of 10 digits, but the second block isn't considered part of [:xdigit:]. This happens in Thai on Windows. The POSIX standard http://pubs.opengroup.org/onlinepubs/9699919799/ does not use very clear language, but I'm taking it as meaning it is ok for this to happen, so this revises the test to accept it. M lib/locale.t ----------------------------------------------------------------------- Summary of changes: lib/locale.t | 71 +++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 53 insertions(+), 18 deletions(-) diff --git a/lib/locale.t b/lib/locale.t index 2b1724c..d1b7723 100644 --- a/lib/locale.t +++ b/lib/locale.t @@ -36,9 +36,9 @@ my $debug = $ENV{PERL_DEBUG_FULL_TEST} // 0; # http://markmail.org/message/5jwam4xsx4amsdnv. Also on AIX machines, many # locales call a no-break space a graphic. # (There aren't 1000 locales currently in existence, so 99.9 works) -my $acceptable_fold_failure_percentage = ($^O =~ / ^ ( MSWin32 | AIX ) $ /ix) - ? 99.9 - : 5; +my $acceptable_failure_percentage = ($^O =~ / ^ ( MSWin32 | AIX ) $ /ix) + ? 99.9 + : 5; # The list of test numbers of the problematic tests. my %problematical_tests; @@ -1107,16 +1107,46 @@ foreach my $Locale (@Locale) { ++$locales_test_number; undef @f; - $test_names{$locales_test_number} = 'Verify that [:digit:] is a subset of [:xdigit:]'; + my @xdigit_digits; # :digit: & :xdigit: + $test_names{$locales_test_number} = 'Verify that [:xdigit:] contains one or two blocks of 10 consecutive [:digit:] chars'; for (map { chr } 0..255) { if ($is_utf8_locale) { use locale ':not_characters'; - push @f, $_ if /[[:digit:]]/ and ! /[[:xdigit:]]/; + # For utf8 locales, we actually use a stricter test: that :digit: + # is a subset of :xdigit:, as we know that only 0-9 should match + push @f, $_ if /[[:digit:]]/ and ! /[[:xdigit:]]/; } else { - push @f, $_ if /[[:digit:]]/ and ! /[[:xdigit:]]/; + push @xdigit_digits, $_ if /[[:digit:]]/ and /[[:xdigit:]]/; } } + if (! $is_utf8_locale) { + + # For non-utf8 locales, @xdigit_digits is a list of the characters + # that are both :xdigit: and :digit:. Because :digit: is stored in + # increasing code point order (unless the tests above failed), + # @xdigit_digits is as well. There should be exactly 10 or + # 20 of these. + if (@xdigit_digits != 10 && @xdigit_digits != 20) { + @f = @xdigit_digits; + } + else { + + # Look for contiguity in the series, adding any wrong ones to @f + my @temp = @xdigit_digits; + while (@temp > 1) { + push @f, $temp[1] if ($temp[0] != $temp[1] - 1) + + # Skip this test for the 0th character of + # the second block of 10, as it won't be + # contiguous with the previous block + && (! defined $xdigit_digits[10] + || $temp[1] != $xdigit_digits[10]); + shift @temp; + } + } + } + report_multi_result($Locale, $locales_test_number, \@f); ++$locales_test_number; @@ -1138,17 +1168,22 @@ foreach my $Locale (@Locale) { $test_names{$locales_test_number} = 'Verify that any additional members of [:xdigit:], are in groups of 6 consecutive code points'; my $previous_ord; my $count = 0; - for (map { chr } 0..255) { - next unless /[[:xdigit:]]/; - next if /[[:digit:]]/; - next if /[A-Fa-f]/; + for my $chr (map { chr } 0..255) { + next unless $chr =~ /[[:xdigit:]]/; + if ($is_utf8_locale) { + next if $chr =~ /[[:digit:]]/; + } + else { + next if grep { $chr eq $_ } @xdigit_digits; + } + next if $chr =~ /[A-Fa-f]/; if (defined $previous_ord) { if ($is_utf8_locale) { use locale ':not_characters'; - push @f, $_ if ord $_ != $previous_ord + 1; + push @f, $chr if ord $chr != $previous_ord + 1; } else { - push @f, $_ if ord $_ != $previous_ord + 1; + push @f, $chr if ord $chr != $previous_ord + 1; } } $count++; @@ -1156,7 +1191,7 @@ foreach my $Locale (@Locale) { undef $previous_ord; } else { - $previous_ord = ord $_; + $previous_ord = ord $chr; } } report_multi_result($Locale, $locales_test_number, \@f); @@ -1910,7 +1945,7 @@ foreach $test_num ($first_locales_test_number..$final_locales_test_number) { my $percent_fail = (int(.5 + (1000 * scalar(keys $Problem{$test_num}) / scalar(@Locale)))) / 10; - if (! $debug && $percent_fail < $acceptable_fold_failure_percentage) + if (! $debug && $percent_fail < $acceptable_failure_percentage) { $test_names{$test_num} .= 'TODO'; print "# ", 100 - $percent_fail, "% of locales pass the following test, so it is likely that the failures\n"; @@ -2126,12 +2161,12 @@ if ($didwarn) { my $s = join(" ", @s); $s =~ s/(.{50,60}) /$1\n#\t/g; - warn + print "# The following locales\n#\n", "#\t", $s, "\n#\n", "# tested okay.\n#\n", } else { - warn "# None of your locales were fully okay.\n"; + print "# None of your locales were fully okay.\n"; } if (@F) { @@ -2146,13 +2181,13 @@ if ($didwarn) { $details = "# For even more details, rerun, with environment variable PERL_DEBUG_FULL_TEST=2.\n"; } - warn + print "# The following locales\n#\n", "#\t", $F, "\n#\n", "# had problems.\n#\n", $details; } else { - warn "# None of your locales were broken.\n"; + print "# None of your locales were broken.\n"; } } -- Perl5 Master Repository
