This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don't test locales that are invalid for needed categories
authorKarl Williamson <public@khwilliamson.com>
Tue, 4 Feb 2014 19:15:14 +0000 (12:15 -0700)
committerKarl Williamson <public@khwilliamson.com>
Tue, 4 Feb 2014 20:30:14 +0000 (13:30 -0700)
When looking for locales to test, skip ones which aren't defined in
every locale category we care about.  This was motivated by a Net BSD
machine which has a Pig Latin locale, but it is defined only for
LC_MESSAGES.

This necessitated adding parameters to pass the desired locale(s), and
renaming a test function to indicate the current category it is valid
for.

ext/XS-APItest/t/handy.t
lib/locale.t
t/loc_tools.pl
t/op/lc.t
t/re/charset.t
t/re/fold_grind.t
t/run/locale.t
t/uni/fold.t

index 41f5c7f..ef7ace9 100644 (file)
@@ -1,7 +1,7 @@
 #!perl -w
 
 BEGIN {
-    require 'loc_tools.pl';   # Contains find_utf8_locale()
+    require 'loc_tools.pl';   # Contains find_utf8_ctype_locale()
 }
 
 use strict;
@@ -37,7 +37,7 @@ if($Config{d_setlocale}) {
             }
         }
 
-        $utf8_locale = find_utf8_locale();
+        $utf8_locale = find_utf8_ctype_locale();
     }
 }
 
index ae03994..a330aa2 100644 (file)
@@ -456,7 +456,9 @@ my $final_without_setlocale = $test_num;
 
 debug "# Scanning for locales...\n";
 
-my @Locale = find_locales();
+require POSIX; import POSIX ':locale_h';
+
+my @Locale = find_locales([ &POSIX::LC_CTYPE, &POSIX::LC_ALL ]);
 
 debug "# Locales =\n";
 for ( @Locale ) {
@@ -468,9 +470,6 @@ unless (@Locale) {
     exit;
 }
 
-# We shouldn't get this far unless we know this will succeed
-require POSIX;
-import POSIX ':locale_h';
 
 setlocale(&POSIX::LC_ALL, "C");
 
index 31d599e..1f9bc5f 100644 (file)
@@ -9,12 +9,21 @@
 # vendor might have them capitalized erroneously anyway).
 
 sub _trylocale {    # Adds the locale given by the first parameter to the list
-                    # given by the 2nd iff the platform supports the locale,
-                    # and it is not already on the list
+                    # given by the 3rd iff the platform supports the locale in
+                    # each of the categories given by the 2nd parameter, which
+                    # is either a single category or a reference to a list of
+                    # categories
     my $locale = shift;
+    my $categories = shift;
     my $list = shift;
     return if grep { $locale eq $_ } @$list;
-    return unless setlocale(&POSIX::LC_ALL, $locale);
+
+    $categories = [ $categories ] unless ref $categories;
+
+    foreach my $category (@$categories) {
+        return unless setlocale($category, $locale);
+    }
+
     my $badutf8;
     {
         local $SIG{__WARN__} = sub {
@@ -55,8 +64,11 @@ sub _decode_encodings {
     return @enc;
 }
 
-sub find_locales {  # Returns an array of all the locales we found on the
-                    # system
+sub find_locales ($) {  # Returns an array of all the locales we found on the
+                        # system.  The parameter is either a single locale
+                        # category or a reference to a list of categories to
+                        # find valid locales for it or them
+    my $categories = shift;
 
     use Config;;
     my $have_setlocale = $Config{d_setlocale};
@@ -79,16 +91,16 @@ sub find_locales {  # Returns an array of all the locales we found on the
     # this is miniperl.
     require POSIX; import POSIX 'locale_h';
 
-    _trylocale("C", \@Locale);
-    _trylocale("POSIX", \@Locale);
+    _trylocale("C", $categories, \@Locale);
+    _trylocale("POSIX", $categories, \@Locale);
     foreach (0..15) {
-        _trylocale("ISO8859-$_", \@Locale);
-        _trylocale("iso8859$_", \@Locale);
-        _trylocale("iso8859-$_", \@Locale);
-        _trylocale("iso_8859_$_", \@Locale);
-        _trylocale("isolatin$_", \@Locale);
-        _trylocale("isolatin-$_", \@Locale);
-        _trylocale("iso_latin_$_", \@Locale);
+        _trylocale("ISO8859-$_", $categories, \@Locale);
+        _trylocale("iso8859$_", $categories, \@Locale);
+        _trylocale("iso8859-$_", $categories, \@Locale);
+        _trylocale("iso_8859_$_", $categories, \@Locale);
+        _trylocale("isolatin$_", $categories, \@Locale);
+        _trylocale("isolatin-$_", $categories, \@Locale);
+        _trylocale("iso_latin_$_", $categories, \@Locale);
     }
 
     # Sanitize the environment so that we can run the external 'locale'
@@ -109,7 +121,7 @@ sub find_locales {  # Returns an array of all the locales we found on the
             # locales will cause all IO hadles to default to (assume) utf8
             next unless utf8::valid($_);
             chomp;
-            _trylocale($_, \@Locale);
+            _trylocale($_, $categories, \@Locale);
         }
         close(LOCALES);
     } elsif ($^O eq 'VMS'
@@ -121,7 +133,7 @@ sub find_locales {  # Returns an array of all the locales we found on the
         opendir(LOCALES, "SYS\$I18N_LOCALE:");
         while ($_ = readdir(LOCALES)) {
             chomp;
-            _trylocale($_, \@Locale);
+            _trylocale($_, $categories, \@Locale);
         }
         close(LOCALES);
     } elsif (($^O eq 'openbsd' || $^O eq 'bitrig' ) && -e '/usr/share/locale') {
@@ -132,7 +144,7 @@ sub find_locales {  # Returns an array of all the locales we found on the
         opendir(LOCALES, '/usr/share/locale');
         while ($_ = readdir(LOCALES)) {
             chomp;
-            _trylocale($_, \@Locale);
+            _trylocale($_, $categories, \@Locale);
         }
         close(LOCALES);
     } else { # Final fallback.  Try our list of locales hard-coded here
@@ -157,27 +169,27 @@ sub find_locales {  # Returns an array of all the locales we found on the
                 split /:/, $line;
             my @enc = _decode_encodings($encodings);
             foreach my $loc (split(/ /, $locale_name)) {
-                _trylocale($loc, \@Locale);
+                _trylocale($loc, $categories, \@Locale);
                 foreach my $enc (@enc) {
-                    _trylocale("$loc.$enc", \@Locale);
+                    _trylocale("$loc.$enc", $categories, \@Locale);
                 }
                 $loc = lc $loc;
                 foreach my $enc (@enc) {
-                    _trylocale("$loc.$enc", \@Locale);
+                    _trylocale("$loc.$enc", $categories, \@Locale);
                 }
             }
             foreach my $lang (split(/ /, $language_codes)) {
-                _trylocale($lang, \@Locale);
+                _trylocale($lang, $categories, \@Locale);
                 foreach my $country (split(/ /, $country_codes)) {
                     my $lc = "${lang}_${country}";
-                    _trylocale($lc, \@Locale);
+                    _trylocale($lc, $categories, \@Locale);
                     foreach my $enc (@enc) {
-                        _trylocale("$lc.$enc", \@Locale);
+                        _trylocale("$lc.$enc", $categories, \@Locale);
                     }
                     my $lC = "${lang}_\U${country}";
-                    _trylocale($lC, \@Locale);
+                    _trylocale($lC, $categories, \@Locale);
                     foreach my $enc (@enc) {
-                        _trylocale("$lC.$enc", \@Locale);
+                        _trylocale("$lC.$enc", $categories, \@Locale);
                     }
                 }
             }
@@ -192,7 +204,7 @@ sub find_locales {  # Returns an array of all the locales we found on the
 }
 
 sub is_locale_utf8 ($) { # Return a boolean as to if core Perl thinks the input
-                        # is a UTF-8 locale
+                         # is a UTF-8 locale
     my $locale = shift;
 
     use locale;
@@ -230,14 +242,15 @@ sub is_locale_utf8 ($) { # Return a boolean as to if core Perl thinks the input
     return $ret;
 }
 
-sub find_utf8_locale (;$) { # Return the name of locale that core Perl thinks
-                            # is a UTF-8 locale.  Optional second parameter is
-                            # a reference to a list of locales to try; if
-                            # omitted, this tries all locales it can find on
-                            # the platform
+sub find_utf8_ctype_locale (;$) { # Return the name of locale that core Perl
+                                  # thinks is a UTF-8 LC_CTYPE locale.
+                                  # Optional parameter is a reference to a
+                                  # list of locales to try; if omitted, this
+                                  # tries all locales it can find on the
+                                  # platform
     my $locales_ref = shift;
     if (! defined $locales_ref) {
-        my @locales = find_locales();
+        my @locales = find_locales(&POSIX::LC_CTYPE());
         $locales_ref = \@locales;
     }
 
index 9d3240b..38d2b6b 100644 (file)
--- a/t/op/lc.t
+++ b/t/op/lc.t
@@ -7,7 +7,7 @@ BEGIN {
     @INC = '../lib';
     require Config; import Config;
     require './test.pl';
-    require './loc_tools.pl';   # Contains find_utf8_locale()
+    require './loc_tools.pl';   # Contains find_utf8_ctype_locale()
 }
 
 use feature qw( fc );
@@ -317,7 +317,7 @@ like lc delete $h{k}, qr "^i\x{307}bcde=array\(.*\)",
     'lc(TEMP ref) does not produce a corrupt string';
 
 
-my $utf8_locale = find_utf8_locale();
+my $utf8_locale = find_utf8_ctype_locale();
 
 SKIP: {
     skip 'Can\'t find a UTF-8 locale', 4*256 unless defined $utf8_locale;
index 578964b..ad2e952 100644 (file)
@@ -60,7 +60,7 @@ if (! is_miniperl() && $Config{d_setlocale}) {
     skip_adding_C_locale:
 
         # Use a pseudo-modifier 'L' to indicate to use /l with a UTF-8 locale
-        $utf8_locale = find_utf8_locale();
+        $utf8_locale = find_utf8_ctype_locale();
         push @charsets, 'L' if defined $utf8_locale;
     }
 }
index 203c9cf..a7a846c 100644 (file)
@@ -439,7 +439,7 @@ if($Config{d_setlocale}) {
 
         # Look for utf8 locale.  We use the pseudo-modifier 'L' to indicate
         # that we really want /l, but change to a UTF-8 locale.
-        $utf8_locale = find_utf8_locale();
+        $utf8_locale = find_utf8_ctype_locale();
         push @charsets, 'L' if defined $utf8_locale;
     }
 }
index 5e27e5b..fbee2d6 100644 (file)
@@ -21,7 +21,7 @@ BEGIN {
 }
 use Config;
 my $have_strtod = $Config{d_strtod} eq 'define';
-my @locales = find_locales();
+my @locales = find_locales( [ LC_ALL, LC_CTYPE, LC_NUMERIC ] );
 skip_all("no locales available") unless @locales;
 
 plan tests => &last;
index 6cad86d..bb4b07e 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
     @INC = '../lib';
     require Config; import Config;
     require './test.pl';
-    require './loc_tools.pl';   # Contains find_utf8_locale()
+    require './loc_tools.pl';   # Contains find_utf8_ctype_locale()
 }
 
 use feature 'unicode_strings';
@@ -448,7 +448,7 @@ foreach my $test_ref (@CF) {
     }
 }
 
-my $utf8_locale = find_utf8_locale();
+my $utf8_locale = find_utf8_ctype_locale();
 
 {
     use feature qw( fc );