perldelta for 273df2b1892a ... 273df2b1892

[perl5.git] / lib / locale.t

diff --git a/lib/locale.t b/lib/locale.t
index 1c25704..6b5616c 100644 (file)
--- a/lib/locale.t
+++ b/lib/locale.t
@@ -9,6 +9,9 @@
 
 my $is_ebcdic = ord("A") == 193;
 
+no warnings 'locale';  # We test even weird locales; and do some scary things
+                       # in ok locales
+
 binmode STDOUT, ':utf8';
 binmode STDERR, ':utf8';
 
@@ -16,17 +19,17 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     unshift @INC, '.';
-    require Config; import Config;
-    if (!$Config{d_setlocale} || $Config{ccflags} =~ /\bD?NO_LOCALE\b/) {
+    require './loc_tools.pl';
+    unless (locales_enabled('LC_CTYPE')) {
        print "1..0\n";
        exit;
     }
-    require './loc_tools.pl';
     $| = 1;
+    require Config; import Config;
 }
 
 use strict;
-use feature 'fc';
+use feature 'fc', 'postderef';
 
 # =1 adds debugging output; =2 increases the verbosity somewhat
 my $debug = $ENV{PERL_DEBUG_FULL_TEST} // 0;
@@ -60,7 +63,7 @@ my $dumper = Dumpvalue->new(
 sub debug {
   return unless $debug;
   my($mess) = join "", '# ', @_;
-  chop $mess;
+  chomp $mess;
   print STDERR $dumper->stringify($mess,1), "\n";
 }
 
@@ -85,6 +88,7 @@ sub ok {
     print "ok " . ++$test_num;
     print " $message";
     print "\n";
+    return ($result) ? 1 : 0;
 }
 
 # First we'll do a lot of taint checking for locales.
@@ -112,6 +116,20 @@ sub check_taint_not ($;$) {
     ok((not is_tainted($_[0])), "verify that isn't tainted$message_tail");
 }
 
+foreach my $category (qw(ALL COLLATE CTYPE MESSAGES MONETARY NUMERIC TIME)) {
+    my $short_result = locales_enabled($category);
+    ok ($short_result == 0 || $short_result == 1,
+        "Verify locales_enabled('$category') returns 0 or 1");
+    debug("locales_enabled('$category') returned '$short_result'");
+    my $long_result = locales_enabled("LC_$category");
+    if (! ok ($long_result == $short_result,
+              "   and locales_enabled('LC_$category') returns "
+            . "the same value")
+    ) {
+        debug("locales_enabled('LC_$category') returned $long_result");
+    }
+}
+
 "\tb\t" =~ /^m?(\s)(.*)\1$/;
 check_taint_not   $&, "not tainted outside 'use locale'";
 ;
@@ -712,8 +730,6 @@ debug "Scanning for locales...\n";
 
 require POSIX; import POSIX ':locale_h';
 
-no warnings 'locale';  # We test even weird locales;
-
 my @Locale = find_locales([ &POSIX::LC_CTYPE, &POSIX::LC_NUMERIC, &POSIX::LC_ALL ]);
 
 debug "Locales =\n";
@@ -847,7 +863,8 @@ sub disp_str ($) {
             }
             else {
                 $result .= "  " unless $prev_was_punct;
-                $result .= charnames::viacode(ord $char);
+                my $name = charnames::viacode(ord $char);
+                $result .= (defined $name) ? $name : ':unknown:';
                 $prev_was_punct = 0;
             }
         }
@@ -1855,7 +1872,9 @@ foreach my $Locale (@Locale) {
             # first).  This is only done if the current locale has LC_MESSAGES
             $ok14 = 1;
             $ok14_5 = 1;
-            if (setlocale(&POSIX::LC_MESSAGES, $Locale)) {
+            if (   locales_enabled('LC_MESSAGES')
+                && setlocale(&POSIX::LC_MESSAGES, $Locale))
+            {
                 foreach my $err (keys %!) {
                     use Errno;
                     $! = eval "&Errno::$err";   # Convert to strerror() output
@@ -1903,14 +1922,16 @@ foreach my $Locale (@Locale) {
     }
 
     $ok21 = 1;
-    foreach my $err (keys %!) {
-        no locale;
-        use Errno;
-        $! = eval "&Errno::$err";   # Convert to strerror() output
-        my $strerror = "$!";
-        if ("$strerror" =~ /\P{ASCII}/) {
-            $ok21 = 0;
-            last;
+    if (locales_enabled('LC_MESSAGES')) {
+        foreach my $err (keys %!) {
+            no locale;
+            use Errno;
+            $! = eval "&Errno::$err";   # Convert to strerror() output
+            my $strerror = "$!";
+            if ("$strerror" =~ /\P{ASCII}/) {
+                $ok21 = 0;
+                last;
+            }
         }
     }
 
@@ -2259,14 +2280,14 @@ foreach $test_num ($first_locales_test_number..$final_locales_test_number) {
         if (($Okay{$test_num} || $Known_bad_locale{$test_num})
             && grep { $_ == $test_num } keys %problematical_tests)
         {
-            no warnings 'experimental::autoderef';
+            no warnings 'experimental::postderef';
 
             # Don't count the known-bad failures when calculating the
             # percentage that fail.
             my $known_failures = (exists $Known_bad_locale{$test_num})
-                                  ? scalar(keys $Known_bad_locale{$test_num})
+                                  ? scalar(keys $Known_bad_locale{$test_num}->%*)
                                   : 0;
-            my $adjusted_failures = scalar(keys $Problem{$test_num})
+            my $adjusted_failures = scalar(keys $Problem{$test_num}->%*)
                                     - $known_failures;
 
             # Specially handle failures where only known-bad locales fail.
@@ -2274,7 +2295,7 @@ foreach $test_num ($first_locales_test_number..$final_locales_test_number) {
             if ($adjusted_failures <= 0) {
                 print "not ok $test_num $test_names{$test_num} # TODO fails only on ",
                                                                 "known bad locales: ",
-                      join " ", keys $Known_bad_locale{$test_num}, "\n";
+                      join " ", keys $Known_bad_locale{$test_num}->%*, "\n";
                 next TEST_NUM;
             }
 
@@ -2293,7 +2314,7 @@ foreach $test_num ($first_locales_test_number..$final_locales_test_number) {
             }
             if ($debug) {
                 print "# $percent_fail% of locales (",
-                      scalar(keys $Problem{$test_num}),
+                      scalar(keys $Problem{$test_num}->%*),
                       " of ",
                       scalar(@Locale),
                       ") fail the above test (TODO cut-off is ",