Enable perl core tests to pass when locale support is not available.
authorJess Robinson <castaway@desert-island.me.uk>
Fri, 8 Feb 2013 12:30:05 +0000 (12:30 +0000)
committerKarl Williamson <public@khwilliamson.com>
Sun, 10 Feb 2013 03:54:45 +0000 (20:54 -0700)
use locale - this will now die if $Config{d_setlocale} is not true.
All tests that use locale will skip if $Config{d_setlocale} is not true.
This enables us to pass tests on Android which uses ICU instead of locales.

The committer removed trailing white space

14 files changed:
ext/Pod-Html/lib/Pod/Html.pm
ext/XS-APItest/t/handy.t
ext/re/t/re_funcs_u.t
ext/re/t/reflags.t
lib/locale.pm
lib/version/t/07locale.t
t/op/quotemeta.t
t/op/taint.t
t/re/charset.t
t/re/fold_grind.t
t/re/pat.t
t/run/locale.t
t/uni/fold.t
t/uni/overload.t

index 5b4c51c..72b37c2 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 require Exporter;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = 1.17;
+$VERSION = 1.18;
 @ISA = qw(Exporter);
 @EXPORT = qw(pod2html htmlify);
 @EXPORT_OK = qw(anchorify);
@@ -16,8 +16,11 @@ use File::Spec;
 use File::Spec::Unix;
 use Getopt::Long;
 use Pod::Simple::Search;
-
-use locale; # make \w work right in non-ASCII lands
+BEGIN {
+    if($Config{d_setlocale}) {
+        require locale; import locale; # make \w work right in non-ASCII lands
+    }
+}
 
 =head1 NAME
 
index 5ecbaa7..eb620ec 100644 (file)
@@ -2,6 +2,7 @@
 
 use strict;
 use Test::More;
+use Config;
 
 use XS::APItest;
 
@@ -11,17 +12,24 @@ sub truth($) {  # Converts values so is() works
     return (shift) ? 1 : 0;
 }
 
-require POSIX;
-my $locale = POSIX::setlocale( &POSIX::LC_ALL, "C");
-if (defined $locale && $locale eq 'C') {
-    use locale;
-
-    # Some locale implementations don't have the 128-255 characters all
-    # mean nothing.  Skip the locale tests in that situation
-    for my $i (128 .. 255) {
-        if (chr($i) =~ /[[:print:]]/) {
-            undef $locale;
-            last;
+my $locale;
+if($Config{d_setlocale}) {
+    require POSIX;
+    $locale = POSIX::setlocale( &POSIX::LC_ALL, "C");
+    if (defined $locale && $locale eq 'C') {
+        BEGIN {
+            if($Config{d_setlocale}) {
+                require locale; import locale; # make \w work right in non-ASCII lands
+            }
+        }
+
+        # Some locale implementations don't have the 128-255 characters all
+        # mean nothing.  Skip the locale tests in that situation
+        for my $i (128 .. 255) {
+            if (chr($i) =~ /[[:print:]]/) {
+                undef $locale;
+                last;
+            }
         }
     }
 }
@@ -138,7 +146,7 @@ foreach my $name (sort keys %properties) {
             }
 
             if (defined $locale) {
-                use locale;
+                require locale; import locale;
 
                 $ret = truth eval "test_is${function}_LC($i)";
                 if ($@) {
@@ -160,7 +168,7 @@ foreach my $name (sort keys %properties) {
         }
 
         if (defined $locale && $name ne 'vertws') {
-            use locale;
+            require locale; import locale;
 
             $ret = truth eval "test_is${function}_LC_uvchr('$i')";
             if ($@) {
@@ -184,7 +192,7 @@ foreach my $name (sort keys %properties) {
         }
 
         if ($name ne 'vertws' && defined $locale) {
-            use locale;
+            require locale; import locale;
 
             $ret = truth eval "test_is${function}_LC_utf8('$char')";
             if ($@) {
index 3eec289..706437e 100644 (file)
@@ -92,6 +92,7 @@ if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){
 
     SKIP: {
         skip_if_miniperl("no dynamic loading on miniperl, no POSIX", 3);
+        skip 'No locale testing without d_setlocale', 3 if(!$Config::Config{d_setlocale});
         require POSIX;
         my $current_locale = POSIX::setlocale( &POSIX::LC_CTYPE, 'de_DE.ISO-8859-1' );
         if ( !$current_locale || $current_locale ne 'de_DE.ISO-8859-1' ) {
@@ -108,6 +109,7 @@ if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){
 
     SKIP: {
         skip_if_miniperl("no dynamic loading on miniperl, no POSIX", 3);
+        skip 'No locale testing without d_setlocale', 3 if(!$Config::Config{d_setlocale});
         require POSIX;
         my $current_locale = POSIX::setlocale( &POSIX::LC_CTYPE, 'C' );
         if ( !$current_locale || $current_locale ne 'C' ) {
index b2cbf80..482b2c8 100644 (file)
@@ -60,7 +60,11 @@ SKIP: {
   ) {
     skip "no locale support", 7
   }
-  use locale;
+  BEGIN {
+      if($Config::Config{d_setlocale}) {
+          require locale; import locale;
+      }
+  }
   use re '/u';
   is qr//, '(?^u:)', 'use re "/u" with active locale';
   no re '/u';
index e57a5fd..ed254cc 100644 (file)
@@ -1,6 +1,7 @@
 package locale;
 
-our $VERSION = '1.01';
+our $VERSION = '1.02';
+use Config;
 
 $Carp::Internal{ (__PACKAGE__) } = 1;
 
@@ -46,6 +47,14 @@ Unicode and locales, including UTF-8 locales.
 See L<perllocale> for more detailed information on how Perl supports
 locales.
 
+=head1 NOTE
+
+If your system does not support locales, then loading this module will
+cause the program to die with a message:
+
+    "Your vendor does not support locales, you cannot use the locale
+    module."
+
 =cut
 
 # A separate bit is used for each of the two forms of the pragma, as they are
@@ -60,6 +69,12 @@ $locale::not_chars_hint_bits = 0x10;
 
 sub import {
     shift;  # should be 'locale'; not checked
+
+    if(!$Config{d_setlocale}) {
+        ## No locale support found on this Perl, giving up:
+        die('Your vendor does not support locales, you cannot use the locale module.');
+    }
+
     my $found_not_chars = 0;
     while (defined (my $arg = shift)) {
         if ($arg eq ":not_characters") {
index 01b51a7..a2005f8 100644 (file)
@@ -8,6 +8,7 @@ use File::Basename;
 use File::Temp qw/tempfile/;
 use POSIX qw/locale_h/;
 use Test::More tests => 7;
+use Config;
 
 BEGIN {
     use_ok('version', 0.9901);
@@ -15,6 +16,7 @@ BEGIN {
 
 SKIP: {
        skip 'No locale testing for Perl < 5.6.0', 6 if $] < 5.006;
+        skip 'No locale testing without d_setlocale', 6 if(!$Config{d_setlocale});
        # test locale handling
        my $warning;
        local $SIG{__WARN__} = sub { $warning = $_[0] };
index d62563c..1b8613a 100644 (file)
@@ -76,7 +76,9 @@ is(length(quotemeta($char)), 1, "quotemeta '\\N{U+D8}'  in UTF-8 length");
     is(quotemeta("\x{d8}"), "\\\x{d8}", "quotemeta Latin1 no unicode_strings quoted");
     is(length(quotemeta("\x{d8}")), 2, "quotemeta Latin1 no unicode_strings quoted length");
 
-    use locale;
+  SKIP: {
+    skip 'No locale testing without d_setlocale', 8 if(!$Config{d_setlocale});
+    require locale; import locale;
 
     my $char = ":";
     is(quotemeta($char), "\\$char", "quotemeta '$char' locale");
@@ -94,6 +96,7 @@ is(length(quotemeta($char)), 1, "quotemeta '\\N{U+D8}'  in UTF-8 length");
     $char = "\x{D8}";  # Every non-ASCII Latin1 is quoted in locale.
     is(quotemeta($char), "\\$char", "quotemeta '\\x{D8}' locale");
     is(length(quotemeta($char)), 2, "quotemeta '\\x{D8}' locale length");
+    }
 }
 {
     use feature 'unicode_strings';
@@ -102,7 +105,13 @@ is(length(quotemeta($char)), 1, "quotemeta '\\N{U+D8}'  in UTF-8 length");
     is(quotemeta("\x{d8}"), "\x{d8}", "quotemeta Latin1 unicode_strings nonquoted");
     is(length(quotemeta("\x{d8}")), 1, "quotemeta Latin1 unicode_strings nonquoted length");
 
-    use locale;
+  SKIP: {
+    skip 'No locale testing without d_setlocale', 12 if(!$Config{d_setlocale});
+    BEGIN {
+        if($Config{d_setlocale}) {
+            require locale; import locale;
+        }
+    }
 
     my $char = ":";
     utf8::upgrade($char);
@@ -128,6 +137,7 @@ is(length(quotemeta($char)), 1, "quotemeta '\\N{U+D8}'  in UTF-8 length");
     is(length(quotemeta("\x{263a}")), 2, "quotemeta locale Unicode quoted length");
     is(quotemeta("\x{100}"), "\x{100}", "quotemeta locale Unicode nonquoted");
     is(length(quotemeta("\x{100}")), 1, "quotemeta locale Unicode nonquoted length");
+  }
 }
 
 $a = "foo|bar";
index d621de6..f5b913b 100644 (file)
@@ -296,25 +296,43 @@ my $TEST = 'TEST';
     is($res, 1,        "$desc: res value");
     is($one, 'a',      "$desc: \$1 value");
 
-    $desc = "match with pattern tainted via locale";
+  SKIP: {
+        skip 'No locale testing without d_setlocale', 10 if(!$Config{d_setlocale});
 
-    $s = 'abcd';
-    { use locale; $res = $s =~ /(\w+)/; $one = $1; }
-    isnt_tainted($s,   "$desc: s not tainted");
-    isnt_tainted($res, "$desc: res not tainted");
-    is_tainted($one,   "$desc: \$1 tainted");
-    is($res, 1,        "$desc: res value");
-    is($one, 'abcd',   "$desc: \$1 value");
-
-    $desc = "match /g with pattern tainted via locale";
+        $desc = "match with pattern tainted via locale";
 
-    $s = 'abcd';
-    { use locale; $res = $s =~ /(\w)/g; $one = $1; }
-    isnt_tainted($s,   "$desc: s not tainted");
-    isnt_tainted($res, "$desc: res not tainted");
-    is_tainted($one,   "$desc: \$1 tainted");
-    is($res, 1,        "$desc: res value");
-    is($one, 'a',      "$desc: \$1 value");
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $res = $s =~ /(\w+)/; $one = $1;
+        }
+        isnt_tainted($s,   "$desc: s not tainted");
+        isnt_tainted($res, "$desc: res not tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($res, 1,        "$desc: res value");
+        is($one, 'abcd',   "$desc: \$1 value");
+
+        $desc = "match /g with pattern tainted via locale";
+
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $res = $s =~ /(\w)/g; $one = $1;
+        }
+        isnt_tainted($s,   "$desc: s not tainted");
+        isnt_tainted($res, "$desc: res not tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($res, 1,        "$desc: res value");
+        is($one, 'a',      "$desc: \$1 value");
+    }
 
     $desc = "match with pattern tainted, list cxt";
 
@@ -339,27 +357,45 @@ my $TEST = 'TEST';
     is($res2,'b',      "$desc: res2 value");
     is($one, 'd',      "$desc: \$1 value");
 
-    $desc = "match with pattern tainted via locale, list cxt";
+  SKIP: {
+        skip 'No locale testing without d_setlocale', 12 if(!$Config{d_setlocale});
 
-    $s = 'abcd';
-    { use locale; ($res) = $s =~ /(\w+)/; $one = $1; }
-    isnt_tainted($s,   "$desc: s not tainted");
-    is_tainted($res,   "$desc: res tainted");
-    is_tainted($one,   "$desc: \$1 tainted");
-    is($res, 'abcd',   "$desc: res value");
-    is($one, 'abcd',   "$desc: \$1 value");
-
-    $desc = "match /g with pattern tainted via locale, list cxt";
+        $desc = "match with pattern tainted via locale, list cxt";
 
-    $s = 'abcd';
-    { use locale; ($res, $res2) = $s =~ /(\w)/g; $one = $1; }
-    isnt_tainted($s,   "$desc: s not tainted");
-    is_tainted($res,   "$desc: res tainted");
-    is_tainted($res2,  "$desc: res2 tainted");
-    is_tainted($one,   "$desc: \$1 tainted");
-    is($res, 'a',      "$desc: res value");
-    is($res2,'b',      "$desc: res2 value");
-    is($one, 'd',      "$desc: \$1 value");
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            ($res) = $s =~ /(\w+)/; $one = $1;
+        }
+        isnt_tainted($s,   "$desc: s not tainted");
+        is_tainted($res,   "$desc: res tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($res, 'abcd',   "$desc: res value");
+        is($one, 'abcd',   "$desc: \$1 value");
+
+        $desc = "match /g with pattern tainted via locale, list cxt";
+
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            ($res, $res2) = $s =~ /(\w)/g; $one = $1;
+        }
+        isnt_tainted($s,   "$desc: s not tainted");
+        is_tainted($res,   "$desc: res tainted");
+        is_tainted($res2,  "$desc: res2 tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($res, 'a',      "$desc: res value");
+        is($res2,'b',      "$desc: res2 value");
+        is($one, 'd',      "$desc: \$1 value");
+    }
 
     $desc = "substitution with string tainted";
 
@@ -481,38 +517,63 @@ my $TEST = 'TEST';
     is($res, 'xyz',    "$desc: res value");
     is($one, 'abcd',   "$desc: \$1 value");
 
-    $desc = "substitution with pattern tainted via locale";
-
-    $s = 'abcd';
-    { use locale;  $res = $s =~ s/(\w+)/xyz/; $one = $1; }
-    is_tainted($s,     "$desc: s tainted");
-    isnt_tainted($res, "$desc: res not tainted");
-    is_tainted($one,   "$desc: \$1 tainted");
-    is($s,  'xyz',     "$desc: s value");
-    is($res, 1,        "$desc: res value");
-    is($one, 'abcd',   "$desc: \$1 value");
-
-    $desc = "substitution /g with pattern tainted via locale";
+  SKIP: {
+        skip 'No locale testing without d_setlocale', 18 if(!$Config{d_setlocale});
 
-    $s = 'abcd';
-    { use locale;  $res = $s =~ s/(\w)/x/g; $one = $1; }
-    is_tainted($s,     "$desc: s tainted");
-    is_tainted($res,   "$desc: res tainted");
-    is_tainted($one,   "$desc: \$1 tainted");
-    is($s,  'xxxx',    "$desc: s value");
-    is($res, 4,        "$desc: res value");
-    is($one, 'd',      "$desc: \$1 value");
-
-    $desc = "substitution /r with pattern tainted via locale";
+        $desc = "substitution with pattern tainted via locale";
 
-    $s = 'abcd';
-    { use locale;  $res = $s =~ s/(\w+)/xyz/r; $one = $1; }
-    isnt_tainted($s,   "$desc: s not tainted");
-    is_tainted($res,   "$desc: res tainted");
-    is_tainted($one,   "$desc: \$1 tainted");
-    is($s,  'abcd',    "$desc: s value");
-    is($res, 'xyz',    "$desc: res value");
-    is($one, 'abcd',   "$desc: \$1 value");
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $res = $s =~ s/(\w+)/xyz/; $one = $1;
+        }
+        is_tainted($s,     "$desc: s tainted");
+        isnt_tainted($res, "$desc: res not tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($s,  'xyz',     "$desc: s value");
+        is($res, 1,        "$desc: res value");
+        is($one, 'abcd',   "$desc: \$1 value");
+
+        $desc = "substitution /g with pattern tainted via locale";
+
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $res = $s =~ s/(\w)/x/g; $one = $1;
+        }
+        is_tainted($s,     "$desc: s tainted");
+        is_tainted($res,   "$desc: res tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($s,  'xxxx',    "$desc: s value");
+        is($res, 4,        "$desc: res value");
+        is($one, 'd',      "$desc: \$1 value");
+
+        $desc = "substitution /r with pattern tainted via locale";
+
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $res = $s =~ s/(\w+)/xyz/r; $one = $1;
+        }
+        isnt_tainted($s,   "$desc: s not tainted");
+        is_tainted($res,   "$desc: res tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($s,  'abcd',    "$desc: s value");
+        is($res, 'xyz',    "$desc: res value");
+        is($one, 'abcd',   "$desc: \$1 value");
+    }
 
     $desc = "substitution with replacement tainted";
 
@@ -652,25 +713,43 @@ my $TEST = 'TEST';
        is($res, 1,        "$desc: res value");
        is($one, 'a',      "$desc: \$1 value");
 
-       $desc = "use re 'taint': match with pattern tainted via locale";
+  SKIP: {
+        skip 'No locale testing without d_setlocale', 10 if(!$Config{d_setlocale});
 
-       $s = 'abcd';
-       { use locale; $res = $s =~ /(\w+)/; $one = $1; }
-       isnt_tainted($s,   "$desc: s not tainted");
-       isnt_tainted($res, "$desc: res not tainted");
-       is_tainted($one,   "$desc: \$1 tainted");
-       is($res, 1,        "$desc: res value");
-       is($one, 'abcd',   "$desc: \$1 value");
-
-       $desc = "use re 'taint': match /g with pattern tainted via locale";
+        $desc = "use re 'taint': match with pattern tainted via locale";
 
-       $s = 'abcd';
-       { use locale; $res = $s =~ /(\w)/g; $one = $1; }
-       isnt_tainted($s,   "$desc: s not tainted");
-       isnt_tainted($res, "$desc: res not tainted");
-       is_tainted($one,   "$desc: \$1 tainted");
-       is($res, 1,        "$desc: res value");
-       is($one, 'a',      "$desc: \$1 value");
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $res = $s =~ /(\w+)/; $one = $1;
+        }
+        isnt_tainted($s,   "$desc: s not tainted");
+        isnt_tainted($res, "$desc: res not tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($res, 1,        "$desc: res value");
+        is($one, 'abcd',   "$desc: \$1 value");
+
+        $desc = "use re 'taint': match /g with pattern tainted via locale";
+
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $res = $s =~ /(\w)/g; $one = $1;
+        }
+        isnt_tainted($s,   "$desc: s not tainted");
+        isnt_tainted($res, "$desc: res not tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($res, 1,        "$desc: res value");
+        is($one, 'a',      "$desc: \$1 value");
+    }
 
        $desc = "use re 'taint': match with pattern tainted, list cxt";
 
@@ -695,27 +774,45 @@ my $TEST = 'TEST';
        is($res2,'b',      "$desc: res2 value");
        is($one, 'd',      "$desc: \$1 value");
 
-       $desc = "use re 'taint': match with pattern tainted via locale, list cxt";
+  SKIP: {
+        skip 'No locale testing without d_setlocale', 12 if(!$Config{d_setlocale});
 
-       $s = 'abcd';
-       { use locale; ($res) = $s =~ /(\w+)/; $one = $1; }
-       isnt_tainted($s,   "$desc: s not tainted");
-       is_tainted($res,   "$desc: res tainted");
-       is_tainted($one,   "$desc: \$1 tainted");
-       is($res, 'abcd',   "$desc: res value");
-       is($one, 'abcd',   "$desc: \$1 value");
-
-       $desc = "use re 'taint': match /g with pattern tainted via locale, list cxt";
+        $desc = "use re 'taint': match with pattern tainted via locale, list cxt";
 
-       $s = 'abcd';
-       { use locale; ($res, $res2) = $s =~ /(\w)/g; $one = $1; }
-       isnt_tainted($s,   "$desc: s not tainted");
-       is_tainted($res,   "$desc: res tainted");
-       is_tainted($res2,  "$desc: res2 tainted");
-       is_tainted($one,   "$desc: \$1 tainted");
-       is($res, 'a',      "$desc: res value");
-       is($res2,'b',      "$desc: res2 value");
-       is($one, 'd',      "$desc: \$1 value");
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            ($res) = $s =~ /(\w+)/; $one = $1;
+        }
+        isnt_tainted($s,   "$desc: s not tainted");
+        is_tainted($res,   "$desc: res tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($res, 'abcd',   "$desc: res value");
+        is($one, 'abcd',   "$desc: \$1 value");
+
+        $desc = "use re 'taint': match /g with pattern tainted via locale, list cxt";
+
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            ($res, $res2) = $s =~ /(\w)/g; $one = $1;
+        }
+        isnt_tainted($s,   "$desc: s not tainted");
+        is_tainted($res,   "$desc: res tainted");
+        is_tainted($res2,  "$desc: res2 tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($res, 'a',      "$desc: res value");
+        is($res2,'b',      "$desc: res2 value");
+        is($one, 'd',      "$desc: \$1 value");
+    }
 
        $desc = "use re 'taint': substitution with string tainted";
 
@@ -838,38 +935,63 @@ my $TEST = 'TEST';
        is($res, 'xyz',    "$desc: res value");
        is($one, 'abcd',   "$desc: \$1 value");
 
-       $desc = "use re 'taint': substitution with pattern tainted via locale";
-
-       $s = 'abcd';
-       { use locale;  $res = $s =~ s/(\w+)/xyz/; $one = $1; }
-       is_tainted($s,     "$desc: s tainted");
-       isnt_tainted($res, "$desc: res not tainted");
-       is_tainted($one,   "$desc: \$1 tainted");
-       is($s,  'xyz',     "$desc: s value");
-       is($res, 1,        "$desc: res value");
-       is($one, 'abcd',   "$desc: \$1 value");
-
-       $desc = "use re 'taint': substitution /g with pattern tainted via locale";
-
-       $s = 'abcd';
-       { use locale;  $res = $s =~ s/(\w)/x/g; $one = $1; }
-       is_tainted($s,     "$desc: s tainted");
-       is_tainted($res,   "$desc: res tainted");
-       is_tainted($one,   "$desc: \$1 tainted");
-       is($s,  'xxxx',    "$desc: s value");
-       is($res, 4,        "$desc: res value");
-       is($one, 'd',      "$desc: \$1 value");
+  SKIP: {
+        skip 'No locale testing without d_setlocale', 18 if(!$Config{d_setlocale});
 
-       $desc = "use re 'taint': substitution /r with pattern tainted via locale";
+        $desc = "use re 'taint': substitution with pattern tainted via locale";
 
-       $s = 'abcd';
-       { use locale;  $res = $s =~ s/(\w+)/xyz/r; $one = $1; }
-       isnt_tainted($s,   "$desc: s not tainted");
-       is_tainted($res,   "$desc: res tainted");
-       is_tainted($one,   "$desc: \$1 tainted");
-       is($s,  'abcd',    "$desc: s value");
-       is($res, 'xyz',    "$desc: res value");
-       is($one, 'abcd',   "$desc: \$1 value");
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $res = $s =~ s/(\w+)/xyz/; $one = $1;
+        }
+        is_tainted($s,     "$desc: s tainted");
+        isnt_tainted($res, "$desc: res not tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($s,  'xyz',     "$desc: s value");
+        is($res, 1,        "$desc: res value");
+        is($one, 'abcd',   "$desc: \$1 value");
+
+        $desc = "use re 'taint': substitution /g with pattern tainted via locale";
+
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $res = $s =~ s/(\w)/x/g; $one = $1;
+        }
+        is_tainted($s,     "$desc: s tainted");
+        is_tainted($res,   "$desc: res tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($s,  'xxxx',    "$desc: s value");
+        is($res, 4,        "$desc: res value");
+        is($one, 'd',      "$desc: \$1 value");
+
+        $desc = "use re 'taint': substitution /r with pattern tainted via locale";
+
+        $s = 'abcd';
+        {
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $res = $s =~ s/(\w+)/xyz/r; $one = $1;
+        }
+        isnt_tainted($s,   "$desc: s not tainted");
+        is_tainted($res,   "$desc: res tainted");
+        is_tainted($one,   "$desc: \$1 tainted");
+        is($s,  'abcd',    "$desc: s value");
+        is($res, 'xyz',    "$desc: res value");
+        is($one, 'abcd',   "$desc: \$1 value");
+    }
 
        $desc = "use re 'taint': substitution with replacement tainted";
 
@@ -2188,9 +2310,15 @@ pass("no death when TARG of ref is tainted");
     isnt_tainted $$, "PID not tainted when read in tainted expression";
 }
 
-{
+SKIP: {
+    skip 'No locale testing without d_setlocale', 4 if(!$Config{d_setlocale});
+
     use feature 'fc';
-    use locale;
+    BEGIN {
+        if($Config{d_setlocale}) {
+            require locale; import locale;
+        }
+    }
     my ($latin1, $utf8) = ("\xDF") x 2;
     utf8::downgrade($latin1);
     utf8::upgrade($utf8);
index 8d98125..ee3625a 100644 (file)
@@ -3,6 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require Config; import Config;
     require './test.pl';
 }
 
@@ -35,11 +36,11 @@ $testcases{'[:space:]'} = $testcases{'\s'};
 $testcases{'[:word:]'} = $testcases{'\w'};
 
 my @charsets = qw(a d u aa);
-if (! is_miniperl()) {
+if (! is_miniperl() && $Config{d_setlocale}) {
     require POSIX;
     my $current_locale = POSIX::setlocale( &POSIX::LC_ALL, "C") // "";
     if ($current_locale eq 'C') {
-        use locale;
+        require locale; import locale;
 
         # Some locale implementations don't have the 128-255 characters all
         # mean nothing.  Skip the locale tests in that situation
index 4e13110..d073498 100644 (file)
@@ -6,6 +6,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
+    require Config; import Config;
     skip_all_if_miniperl("no dynamic loading on miniperl, no Encode nor POSIX");
 }
 
@@ -405,18 +406,20 @@ sub pairs (@) {
 }
 
 my @charsets = qw(d u a aa);
-my $current_locale = POSIX::setlocale( &POSIX::LC_ALL, "C") // "";
-if ($current_locale eq 'C') {
-    use locale;
-
-    # Some locale implementations don't have the range 128-255 characters all
-    # mean nothing.  Skip the locale tests in that situation.
-    for my $i (128 .. 255) {
-        my $char = chr($i);
-        goto bad_locale if uc($char) ne $char || lc($char) ne $char;
+if($Config{d_setlocale}) {
+    my $current_locale = POSIX::setlocale( &POSIX::LC_ALL, "C") // "";
+    if ($current_locale eq 'C') {
+        require locale; import locale;
+
+        # Some locale implementations don't have the range 128-255 characters all
+        # mean nothing.  Skip the locale tests in that situation.
+        for my $i (128 .. 255) {
+            my $char = chr($i);
+            goto bad_locale if uc($char) ne $char || lc($char) ne $char;
+        }
+        push @charsets, 'l';
+      bad_locale:
     }
-    push @charsets, 'l';
-bad_locale:
 }
 
 # Finally ready to do the tests
index 768119f..11ae2d3 100644 (file)
@@ -16,6 +16,7 @@ $| = 1;
 BEGIN {
     chdir 't' if -d 't';
     @INC = ('../lib','.');
+    require Config; import Config;
     require './test.pl';
 }
 
@@ -516,24 +517,52 @@ sub run_tests {
         is(qr/(?u)\b\v$/, '(?^:(?u)\b\v$)', 'Verify (?u) compiles');
 
         my $dual = qr/\b\v$/;
-        use locale;
-        my $locale = qr/\b\v$/;
-        is($locale,    '(?^l:\b\v$)', 'Verify has l modifier when compiled under use locale');
-        no locale;
+        my $locale;
+
+      SKIP: {
+            skip 'No locale testing without d_setlocale', 1 if(!$Config{d_setlocale});
+
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            $locale = qr/\b\v$/;
+            is($locale,    '(?^l:\b\v$)', 'Verify has l modifier when compiled under use locale');
+            no locale;
+        }
 
         use feature 'unicode_strings';
         my $unicode = qr/\b\v$/;
         is($unicode,    '(?^u:\b\v$)', 'Verify has u modifier when compiled under unicode_strings');
         is(qr/abc$dual/,    '(?^u:abc(?^:\b\v$))', 'Verify retains d meaning when interpolated under locale');
-        is(qr/abc$locale/,    '(?^u:abc(?^l:\b\v$))', 'Verify retains l when interpolated under unicode_strings');
+
+      SKIP: {
+            skip 'No locale testing without d_setlocale', 1 if(!$Config{d_setlocale});
+
+            is(qr/abc$locale/,    '(?^u:abc(?^l:\b\v$))', 'Verify retains l when interpolated under unicode_strings');
+        }
 
         no feature 'unicode_strings';
-        is(qr/abc$locale/,    '(?^:abc(?^l:\b\v$))', 'Verify retains l when interpolated outside locale and unicode strings');
+      SKIP: {
+            skip 'No locale testing without d_setlocale', 1 if(!$Config{d_setlocale});
+
+            is(qr/abc$locale/,    '(?^:abc(?^l:\b\v$))', 'Verify retains l when interpolated outside locale and unicode strings');
+        }
+
         is(qr/def$unicode/,    '(?^:def(?^u:\b\v$))', 'Verify retains u when interpolated outside locale and unicode strings');
 
-        use locale;
-        is(qr/abc$dual/,    '(?^l:abc(?^:\b\v$))', 'Verify retains d meaning when interpolated under locale');
-        is(qr/abc$unicode/,    '(?^l:abc(?^u:\b\v$))', 'Verify retains u when interpolated under locale');
+      SKIP: {
+            skip 'No locale testing without d_setlocale', 2 if(!$Config{d_setlocale});
+
+             BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
+            is(qr/abc$dual/,    '(?^l:abc(?^:\b\v$))', 'Verify retains d meaning when interpolated under locale');
+            is(qr/abc$unicode/,    '(?^l:abc(?^u:\b\v$))', 'Verify retains u when interpolated under locale');
+        }
     }
 
     {
index 7bbb0a9..d01e3bc 100644 (file)
@@ -64,7 +64,11 @@ my $original_locale = setlocale(LC_NUMERIC);
 
 my ($base, $different, $difference);
 for ("C", @locales) { # prefer C for the base if available
-    use locale;
+    BEGIN {
+        if($Config{d_setlocale}) {
+            require locale; import locale;
+        }
+    }
     setlocale(LC_NUMERIC, $_) or next;
     my $in = 4.2; # avoid any constant folding bugs
     if ((my $s = sprintf("%g", $in)) eq "4.2")  {
@@ -113,14 +117,15 @@ format STDOUT =
 @.#
 4.179
 .
-{ use locale; write; }
+{ require locale; import locale; write; }
 EOF
            "too late to look at the locale at write() time");
         }
 
         {
            fresh_perl_is(<<'EOF', $difference, {},
-use locale; format STDOUT =
+use locale;
+format STDOUT =
 @.#
 4.179
 .
@@ -134,7 +139,11 @@ EOF
         # do not let "use 5.000" affect the locale!
         # this test is to prevent regression of [rt.perl.org #105784]
         fresh_perl_is(<<"EOF",
-            use locale;
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
             use POSIX;
             my \$i = 0.123;
             POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
@@ -163,7 +172,7 @@ EOF
        local $ENV{LC_NUMERIC} = $_;
        local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
        fresh_perl_is(<<'EOF', "$difference "x4, {},
-           use locale;
+        use locale;
            use POSIX qw(locale_h);
            setlocale(LC_NUMERIC, "");
            my $in = 4.2;
index 4c0ef7d..91356bb 100644 (file)
@@ -7,6 +7,7 @@ use warnings;
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require Config; import Config;
     require './test.pl';
 }
 
@@ -426,8 +427,13 @@ foreach my $test_ref (@CF) {
         utf8::downgrade($latin1); #No-op, but doesn't hurt
         utf8::upgrade($utf8);
         is(fc($latin1), fc($utf8), "fc() gives the same results for \\x{$_} in Latin-1 and UTF-8 under unicode_strings");
-        {
-            use locale;
+        SKIP: {
+              skip 'No locale testing without d_setlocale', 2 if(!$Config{d_setlocale});
+              BEGIN {
+                  if($Config{d_setlocale}) {
+                      require locale; import locale;
+                  }
+              }
             is(fc($latin1), lc($latin1), "use locale; fc(qq{\\x{$_}}), lc(qq{\\x{$_}}) when qq{\\x{$_}} is in latin-1");
             is(fc($utf8), lc($utf8), "use locale; fc(qq{\\x{$_}}), lc(qq{\\x{$_}}) when qq{\\x{$_}} is in latin-1");
         }
index 7bf4841..bd87b66 100644 (file)
@@ -3,6 +3,7 @@
 BEGIN {
     chdir 't';
     @INC = '../lib';
+    require Config; import Config;
     require './test.pl';
 }
 
@@ -95,8 +96,10 @@ is ($uc, "\351", "e acute -> E acute");
 my $have_setlocale = 0;
 eval {
     require POSIX;
-    import POSIX ':locale_h';
-    $have_setlocale++;
+    if($Config{d_setlocale}) {
+        import POSIX ':locale_h';
+        $have_setlocale++;
+    }
 };
 
 SKIP: {
@@ -107,7 +110,11 @@ SKIP: {
     } elsif ($^O eq 'dec_osf' || $^O eq 'VMS') {
        skip "$^O has broken en_GB.ISO8859-1 locale", 24;
     } else {
-       use locale;
+        BEGIN {
+            if($Config{d_setlocale}) {
+                require locale; import locale;
+            }
+        }
        my $u = UTF8Toggle->new("\311");
        my $lc = lc $u;
        is (length $lc, 1);