From 7493b8f27085a78b1c665738d362dda50a60cb10 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 2 Dec 2013 18:28:34 -0700 Subject: [PATCH] lib/locale.t: Make another test TODO if it fails Many platforms have a few locales whose casing functionality is buggy. However if only a few locales have failures, it probably means that Perl is ok; and its the platform's locale definitions that are bad. Earlier, commit 6d5d702a337e9161f8eb85180a83c4469a8f7ed7 enhanced locale.t, if only a few locales fail, to mark some tests which were showing these kinds of bugs as TODOs. This allowed robust tests to be added to locale.t which previously were ommitted so as to not cause the tests to fail if any locale on any platform was bad. Not having these tests allowed real Perl bugs to creep in. This commit adds the /il match testing to the list of these tests. Currently, it is set to hardly catch anything; and this allowed another real bug to be introduced into Perl. This commit was prompted by bugs in Darwin with ISO8859-4 and ISO8859-13 locales. --- lib/locale.t | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/lib/locale.t b/lib/locale.t index 56b68a2..e4d0e17 100644 --- a/lib/locale.t +++ b/lib/locale.t @@ -36,6 +36,10 @@ my $debug = $ENV{PERL_DEBUG_FULL_TEST} // 0; # (There aren't 1000 locales currently in existence, so 99.9 works) my $acceptable_fold_failure_percentage = $^O eq 'MSWin32' ? 99.9 : 5; +# The list of test numbers of the problematic tests. +my @problematical_tests; + + use Dumpvalue; my $dumper = Dumpvalue->new( @@ -797,7 +801,6 @@ my $first_locales_test_number = $final_without_setlocale + 1; my $locales_test_number; my $not_necessarily_a_problem_test_number; my $first_casing_test_number; -my $final_casing_test_number; my %setlocale_failed; # List of locales that setlocale() didn't work on foreach $Locale (@Locale) { @@ -1463,7 +1466,10 @@ foreach $Locale (@Locale) { } report_multi_result($Locale, $locales_test_number, \@f); - $final_casing_test_number = $locales_test_number; + foreach ($first_casing_test_number..$locales_test_number) { + push @problematical_tests, $_; + } + # Test for read-only scalars' locale vs non-locale comparisons. @@ -1966,6 +1972,7 @@ foreach $Locale (@Locale) { } } report_multi_result($Locale, $locales_test_number, \@f); + push @problematical_tests, $locales_test_number; } # [perl #109318] @@ -2018,9 +2025,7 @@ foreach $test_num ($first_locales_test_number..$final_locales_test_number) { print "# It usually indicates a problem in the environment,\n"; print "# not in Perl itself.\n"; } - if ($Okay{$test_num} && ($test_num >= $first_casing_test_number - && $_ <= $final_casing_test_number)) - { + if ($Okay{$test_num} && grep { $_ == $test_num } @problematical_tests) { # Round to nearest .1% my $percent_fail = (int(.5 + (1000 * scalar(keys $Problem{$test_num}) / scalar(@Locale)))) -- 2.7.4