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 }
   7
   8 use strict;
   9
  10 ########
  11 # These tests are here instead of lib/locale.t because
  12 # some bugs depend on in the internal state of the locale
  13 # settings and pragma/locale messes up that state pretty badly.
  14 # We need "fresh runs".
  15 BEGIN {
  16     eval { require POSIX; POSIX->import("locale_h") };
  17     if ($@) {
  18         skip_all("could not load the POSIX module"); # running minitest?
  19     }
  20 }
  21 use Config;
  22 my $have_setlocale = $Config{d_setlocale} eq 'define';
  23 $have_setlocale = 0 if $@;
  24 # Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
  25 # and mingw32 uses said silly CRT
  26 $have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i);
  27 skip_all("no setlocale available") unless $have_setlocale;
  28 my @locales;
  29 if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) {
  30     while(<LOCALES>) {
  31         chomp;
  32         push(@locales, $_);
  33     }
  34     close(LOCALES);
  35 }
  36 skip_all("no locales available") unless @locales;
  37
  38 plan tests => &last;
  39 fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF',
  40     use POSIX qw(locale_h);
  41     use locale;
  42     setlocale(LC_NUMERIC, "$_") or next;
  43     my $s = sprintf "%g %g", 3.1, 3.1;
  44     next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/;
  45     print "$_ $s\n";
  46 }
  47 EOF
  48     "", {}, "no locales where LC_NUMERIC breaks");
  49
  50 fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF',
  51     use POSIX qw(locale_h);
  52     use locale;
  53     my $in = 4.2;
  54     my $s = sprintf "%g", $in; # avoid any constant folding bugs
  55     next if $s eq "4.2";
  56     print "$_ $s\n";
  57 }
  58 EOF
  59     "", {}, "LC_NUMERIC without setlocale() has no effect in any locale");
  60
  61
  62 # try to find out a locale where LC_NUMERIC makes a difference
  63 my $original_locale = setlocale(LC_NUMERIC);
  64
  65 my ($base, $different, $comma, $difference);
  66 for ("C", @locales) { # prefer C for the base if available
  67     BEGIN {
  68         if($Config{d_setlocale}) {
  69             require locale; import locale;
  70         }
  71     }
  72     setlocale(LC_NUMERIC, $_) or next;
  73     my $in = 4.2; # avoid any constant folding bugs
  74     if ((my $s = sprintf("%g", $in)) eq "4.2")  {
  75         $base ||= $_;
  76     } else {
  77         $different ||= $_;
  78         $difference ||= $s;
  79         $comma ||= $_ if localeconv()->{decimal_point} eq ',';
  80     }
  81
  82     last if $base && $different && $comma;
  83 }
  84 setlocale(LC_NUMERIC, $original_locale);
  85
  86 SKIP: {
  87     skip("no locale available where LC_NUMERIC makes a difference", &last - 2)
  88         if !$different;
  89     note("using the '$different' locale for LC_NUMERIC tests");
  90     for ($different) {
  91         local $ENV{LC_NUMERIC} = $_;
  92         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
  93
  94         fresh_perl_is(<<'EOF', "4.2", {},
  95 format STDOUT =
  96 @.#
  97 4.179
  98 .
  99 write;
 100 EOF
 101             "format() does not look at LC_NUMERIC without 'use locale'");
 102
 103         {
 104             fresh_perl_is(<<'EOF', $difference, {},
 105 use locale;
 106 format STDOUT =
 107 @.#
 108 4.179
 109 .
 110 write;
 111 EOF
 112             "format() looks at LC_NUMERIC with 'use locale'");
 113         }
 114
 115         {
 116             fresh_perl_is(<<'EOF', "4.2", {},
 117 format STDOUT =
 118 @.#
 119 4.179
 120 .
 121 { require locale; import locale; write; }
 122 EOF
 123             "too late to look at the locale at write() time");
 124         }
 125
 126         {
 127             fresh_perl_is(<<'EOF', $difference, {},
 128 use locale;
 129 format STDOUT =
 130 @.#
 131 4.179
 132 .
 133 { no locale; write; }
 134 EOF
 135             "too late to ignore the locale at write() time");
 136         }
 137     }
 138
 139     {
 140         # do not let "use 5.000" affect the locale!
 141         # this test is to prevent regression of [rt.perl.org #105784]
 142         fresh_perl_is(<<"EOF",
 143             BEGIN {
 144                 if("$Config{d_setlocale}") {
 145                     require locale; import locale;
 146                 }
 147             }
 148             use POSIX;
 149             my \$i = 0.123;
 150             POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
 151             \$a = sprintf("%.2f", \$i);
 152             require version;
 153             \$b = sprintf("%.2f", \$i);
 154             print ".\$a \$b" unless \$a eq \$b
 155 EOF
 156             "", {}, "version does not clobber version");
 157
 158         fresh_perl_is(<<"EOF",
 159             use locale;
 160             use POSIX;
 161             my \$i = 0.123;
 162             POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
 163             \$a = sprintf("%.2f", \$i);
 164             eval "use v5.0.0";
 165             \$b = sprintf("%.2f", \$i);
 166             print "\$a \$b" unless \$a eq \$b
 167 EOF
 168             "", {}, "version does not clobber version (via eval)");
 169     }
 170
 171     for ($different) {
 172         local $ENV{LC_NUMERIC} = $_;
 173         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
 174         fresh_perl_is(<<'EOF', "$difference "x4, {},
 175         use locale;
 176             use POSIX qw(locale_h);
 177             setlocale(LC_NUMERIC, "");
 178             my $in = 4.2;
 179             printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
 180 EOF
 181         "sprintf() and printf() look at LC_NUMERIC regardless of constant folding");
 182     }
 183
 184     unless ($comma) {
 185         skip("no locale available where LC_NUMERIC is a comma", 2);
 186     }
 187     else {
 188
 189         fresh_perl_is(<<"EOF",
 190             my \$i = 1.5;
 191             {
 192                 use locale;
 193                 use POSIX;
 194                 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
 195                 print \$i, "\n";
 196             }
 197             print \$i, "\n";
 198 EOF
 199             "1,5\n1.5", {}, "Radix print properly in locale scope, and without");
 200
 201         fresh_perl_is(<<"EOF",
 202             my \$i = 1.5;   # Should be exactly representable as a base 2
 203                             # fraction, so can use 'eq' below
 204             use locale;
 205             use POSIX;
 206             POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
 207             print \$i, "\n";
 208             \$i += 1;
 209             print \$i, "\n";
 210 EOF
 211             "1,5\n2,5", {}, "Can do math when radix is a comma"); # [perl 115800]
 212     }
 213
 214 } # SKIP
 215
 216 sub last { 11 }