In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f5d13a25262cb242090ad5e0703cf287e26156db?hp=0b34b372c9a4c040146bce32de62edaef7680db5>
- Log ----------------------------------------------------------------- commit f5d13a25262cb242090ad5e0703cf287e26156db Author: Karl Williamson <[email protected]> Date: Sat Jan 12 08:48:01 2013 -0700 perlapi: Clarify av_pop This notes that the caller now has control of a reference count of the returned SV. Wording mostly suggested by Paul Evans M av.c commit 6d5d702a337e9161f8eb85180a83c4469a8f7ed7 Author: Karl Williamson <[email protected]> Date: Fri Jan 11 14:29:29 2013 -0700 Allow slop on a few locale tests Four recently introduced tests in locale.t fail for two locales of all the ones that get tested in our smoke farm. I investigated the failures and it looks to me like the problem in each case is that the locale definition is defective. The tests were added because of finding and fixing a bug in Perl, so I don't want to remove them. Instead these 4 tests will be marked as TODO if at least 95% of locales pass on any given machine. This works for our current smokers. M lib/locale.t ----------------------------------------------------------------------- Summary of changes: av.c | 5 +++-- lib/locale.t | 22 ++++++++++++++++++++++ 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/av.c b/av.c index b251822..475496d 100644 --- a/av.c +++ b/av.c @@ -592,8 +592,9 @@ Perl_av_push(pTHX_ AV *av, SV *val) /* =for apidoc av_pop -Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array -is empty. +Removes one SV from the end of the array, reducing its size by one and +returning the SV (transferring control of one reference count) to the +caller. Returns C<&PL_sv_undef> if the array is empty. Perl equivalent: C<pop(@myarray);> diff --git a/lib/locale.t b/lib/locale.t index 1270314..a9a5a26 100644 --- a/lib/locale.t +++ b/lib/locale.t @@ -27,6 +27,10 @@ use feature 'fc'; my $debug = 0; +# Certain tests have been shown to be problematical for a few locales. Don't +# fail them unless at least this percentage of the tested locales fail. +my $acceptable_fold_failure_percentage = 5; + use Dumpvalue; my $dumper = Dumpvalue->new( @@ -692,6 +696,8 @@ sub tryneoalpha { 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) { @@ -782,11 +788,14 @@ foreach $Locale (@Locale) { } my $message = ""; $locales_test_number++; + $first_casing_test_number = $locales_test_number; $test_names{$locales_test_number} = 'Verify that /[[:upper:]]/ matches sieved uppercase characters.'; $message = 'Failed for ' . join ", ", @failures if @failures; tryneoalpha($Locale, $locales_test_number, scalar @failures == 0, $message); + $message = ""; $locales_test_number++; + $test_names{$locales_test_number} = 'Verify that /[[:lower:]]/i matches sieved uppercase characters.'; $message = 'Failed for ' . join ", ", @fold_failures if @fold_failures; tryneoalpha($Locale, $locales_test_number, scalar @fold_failures == 0, $message); @@ -818,6 +827,7 @@ foreach $Locale (@Locale) { tryneoalpha($Locale, $locales_test_number, scalar @failures == 0, $message); $message = ""; $locales_test_number++; + $final_casing_test_number = $locales_test_number; $test_names{$locales_test_number} = 'Verify that /[[:upper:]]/i matches sieved lowercase characters.'; $message = 'Failed for ' . join ", ", @fold_failures if @fold_failures; tryneoalpha($Locale, $locales_test_number, scalar @fold_failures == 0, $message); @@ -1370,6 +1380,18 @@ foreach ($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{$_} && ($_ >= $first_casing_test_number + && $_ <= $final_casing_test_number)) + { + my $percent_fail = int(.5 + (100 * scalar(keys $Problem{$_}) + / scalar(@{$Okay{$_}}))); + if ($percent_fail < $acceptable_fold_failure_percentage) { + $test_names{$_} .= 'TODO'; + print "# ", 100 - $percent_fail, "% of locales pass the following test, so it is likely that the failures\n"; + print "# are errors in the locale definitions. The test is marked TODO, as the\n"; + print "# problem is not likely to be Perl's\n"; + } + } print "not "; } print "ok $_"; -- Perl5 Master Repository
