t/run/locale.t

   1 #!./perl
   2 BEGIN {
   3     chdir 't' if -d 't';
   4     @INC = '../lib';
   5     require './test.pl';    # for fresh_perl_is() etc
   6     require './loc_tools.pl'; # to find locales
   7 }
   8
   9 use strict;
  10
  11 ########
  12 # These tests are here instead of lib/locale.t because
  13 # some bugs depend on in the internal state of the locale
  14 # settings and pragma/locale messes up that state pretty badly.
  15 # We need "fresh runs".
  16 BEGIN {
  17     eval { require POSIX; POSIX->import("locale_h") };
  18     if ($@) {
  19         skip_all("could not load the POSIX module"); # running minitest?
  20     }
  21 }
  22 use Config;
  23 my $have_strtod = $Config{d_strtod} eq 'define';
  24 my @locales = find_locales( [ LC_ALL, LC_CTYPE, LC_NUMERIC ] );
  25 skip_all("no locales available") unless @locales;
  26
  27 plan tests => &last;
  28 fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF',
  29     use POSIX qw(locale_h);
  30     use locale;
  31     setlocale(LC_NUMERIC, "$_") or next;
  32     my $s = sprintf "%g %g", 3.1, 3.1;
  33     next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/;
  34     print "$_ $s\n";
  35 }
  36 EOF
  37     "", {}, "no locales where LC_NUMERIC breaks");
  38
  39 {
  40     local $ENV{LC_NUMERIC};
  41     local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
  42     fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF',
  43         use POSIX qw(locale_h);
  44         use locale;
  45         my $in = 4.2;
  46         my $s = sprintf "%g", $in; # avoid any constant folding bugs
  47         next if $s eq "4.2";
  48         print "$_ $s\n";
  49     }
  50 EOF
  51     "", {}, "LC_NUMERIC without environment nor setlocale() has no effect in any locale");
  52 }
  53
  54 # try to find out a locale where LC_NUMERIC makes a difference
  55 my $original_locale = setlocale(LC_NUMERIC);
  56
  57 my ($base, $different, $comma, $difference);
  58 for ("C", @locales) { # prefer C for the base if available
  59     BEGIN {
  60         if($Config{d_setlocale}) {
  61             require locale; import locale;
  62         }
  63     }
  64     setlocale(LC_NUMERIC, $_) or next;
  65     my $in = 4.2; # avoid any constant folding bugs
  66     if ((my $s = sprintf("%g", $in)) eq "4.2")  {
  67         $base ||= $_;
  68     } else {
  69         $different ||= $_;
  70         $difference ||= $s;
  71         $comma ||= $_ if localeconv()->{decimal_point} eq ',';
  72     }
  73
  74     last if $base && $different && $comma;
  75 }
  76 setlocale(LC_NUMERIC, $original_locale);
  77
  78 SKIP: {
  79     skip("no locale available where LC_NUMERIC makes a difference", &last - 2)
  80         if !$different;
  81     note("using the '$different' locale for LC_NUMERIC tests");
  82     for ($different) {
  83         local $ENV{LC_NUMERIC} = $_;
  84         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
  85
  86         fresh_perl_is(<<'EOF', "4.2", {},
  87 format STDOUT =
  88 @.#
  89 4.179
  90 .
  91 write;
  92 EOF
  93             "format() does not look at LC_NUMERIC without 'use locale'");
  94
  95         {
  96             fresh_perl_is(<<'EOF', $difference, {},
  97 use locale;
  98 format STDOUT =
  99 @.#
 100 4.179
 101 .
 102 write;
 103 EOF
 104             "format() looks at LC_NUMERIC with 'use locale'");
 105         }
 106
 107         {
 108             fresh_perl_is(<<'EOF', $difference, {},
 109 use locale ":not_characters";
 110 format STDOUT =
 111 @.#
 112 4.179
 113 .
 114 write;
 115 EOF
 116             "format() looks at LC_NUMERIC with 'use locale \":not_characters\"'");
 117         }
 118
 119         {
 120             fresh_perl_is(<<'EOF', "4.2", {},
 121 format STDOUT =
 122 @.#
 123 4.179
 124 .
 125 { require locale; import locale; write; }
 126 EOF
 127             "too late to look at the locale at write() time");
 128         }
 129
 130         {
 131             fresh_perl_is(<<'EOF', $difference, {},
 132 use locale;
 133 format STDOUT =
 134 @.#
 135 4.179
 136 .
 137 { no locale; write; }
 138 EOF
 139             "too late to ignore the locale at write() time");
 140         }
 141     }
 142
 143     {
 144         # do not let "use 5.000" affect the locale!
 145         # this test is to prevent regression of [rt.perl.org #105784]
 146         fresh_perl_is(<<"EOF",
 147             BEGIN {
 148                 if("$Config{d_setlocale}") {
 149                     require locale; import locale;
 150                 }
 151             }
 152             use POSIX;
 153             my \$i = 0.123;
 154             POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
 155             \$a = sprintf("%.2f", \$i);
 156             require version;
 157             \$b = sprintf("%.2f", \$i);
 158             print ".\$a \$b" unless \$a eq \$b
 159 EOF
 160             "", {}, "version does not clobber version");
 161
 162         fresh_perl_is(<<"EOF",
 163             use locale;
 164             use POSIX;
 165             my \$i = 0.123;
 166             POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
 167             \$a = sprintf("%.2f", \$i);
 168             eval "use v5.0.0";
 169             \$b = sprintf("%.2f", \$i);
 170             print "\$a \$b" unless \$a eq \$b
 171 EOF
 172             "", {}, "version does not clobber version (via eval)");
 173     }
 174
 175     for ($different) {
 176         local $ENV{LC_NUMERIC} = $_;
 177         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
 178         fresh_perl_is(<<'EOF', "$difference "x4, {},
 179         use locale;
 180             use POSIX qw(locale_h);
 181             setlocale(LC_NUMERIC, "");
 182             my $in = 4.2;
 183             printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
 184 EOF
 185         "sprintf() and printf() look at LC_NUMERIC regardless of constant folding");
 186     }
 187
 188     for ($different) {
 189         local $ENV{LC_NUMERIC} = $_;
 190         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
 191         fresh_perl_is(<<"EOF",
 192             use POSIX qw(locale_h);
 193
 194             BEGIN { setlocale(LC_NUMERIC, \"$_\"); };
 195             setlocale(LC_ALL, "C");
 196             use 5.008;
 197             print setlocale(LC_NUMERIC);
 198 EOF
 199          "C", { },
 200          "No compile error on v-strings when setting the locale to non-dot radix at compile time when default environment has non-dot radix");
 201     }
 202
 203     for ($different) {
 204         local $ENV{LC_NUMERIC} = $_;
 205         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
 206         fresh_perl_is(<<"EOF",
 207             use POSIX qw(locale_h);
 208
 209             BEGIN { print setlocale(LC_NUMERIC), "\n"; };
 210 EOF
 211          $_, { },
 212          "Passed in LC_NUMERIC is valid at compilation time");
 213     }
 214
 215     unless ($comma) {
 216         skip("no locale available where LC_NUMERIC is a comma", 2);
 217     }
 218     else {
 219
 220         fresh_perl_is(<<"EOF",
 221             my \$i = 1.5;
 222             {
 223                 use locale;
 224                 use POSIX;
 225                 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
 226                 print \$i, "\n";
 227             }
 228             print \$i, "\n";
 229 EOF
 230             "1,5\n1.5", {}, "Radix print properly in locale scope, and without");
 231
 232         fresh_perl_is(<<"EOF",
 233             my \$i = 1.5;   # Should be exactly representable as a base 2
 234                             # fraction, so can use 'eq' below
 235             use locale;
 236             use POSIX;
 237             POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
 238             print \$i, "\n";
 239             \$i += 1;
 240             print \$i, "\n";
 241 EOF
 242             "1,5\n2,5", {}, "Can do math when radix is a comma"); # [perl 115800]
 243
 244         unless ($have_strtod) {
 245             skip("no strtod()", 1);
 246         }
 247         else {
 248             fresh_perl_is(<<"EOF",
 249                 use POSIX;
 250                 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
 251                 my \$one_point_5 = POSIX::strtod("1,5");
 252                 \$one_point_5 =~ s/0+\$//;  # Remove any trailing zeros
 253                 print \$one_point_5, "\n";
 254 EOF
 255             "1.5", {}, "POSIX::strtod() uses underlying locale");
 256         }
 257     }
 258
 259     {
 260         fresh_perl_is(<<"EOF",
 261                 use locale;
 262                 use POSIX;
 263                 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
 264                 print "h" =~ /[g\\w]/i || 0;
 265                 print "\\n";
 266 EOF
 267             1, {}, "/il matching of [bracketed] doesn't skip POSIX class if fails individ char");
 268     }
 269
 270     {
 271         fresh_perl_is(<<"EOF",
 272                 use locale;
 273                 use POSIX;
 274                 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
 275                 print "0" =~ /[\\d[:punct:]]/l || 0;
 276                 print "\\n";
 277 EOF
 278             1, {}, "/l matching of [bracketed] doesn't skip non-first POSIX class");
 279
 280     }
 281
 282
 283 } # SKIP
 284
 285 sub last { 17 }