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 # try to find out a locale where LC_NUMERIC makes a difference
  62 my $original_locale = setlocale(LC_NUMERIC);
  63
  64 my ($base, $different, $difference);
  65 for ("C", @locales) { # prefer C for the base if available
  66     use locale;
  67     setlocale(LC_NUMERIC, $_) or next;
  68     my $in = 4.2; # avoid any constant folding bugs
  69     if ((my $s = sprintf("%g", $in)) eq "4.2")  {
  70         $base ||= $_;
  71     } else {
  72         $different ||= $_;
  73         $difference ||= $s;
  74     }
  75
  76     last if $base && $different;
  77 }
  78 setlocale(LC_NUMERIC, $original_locale);
  79
  80 SKIP: {
  81     skip("no locale available where LC_NUMERIC makes a difference", &last - 2)
  82         if !$different;
  83     note("using the '$different' locale for LC_NUMERIC tests");
  84     for ($different) {
  85         local $ENV{LC_NUMERIC} = $_;
  86         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
  87
  88         fresh_perl_is(<<'EOF', "4.2", {},
  89 format STDOUT =
  90 @.#
  91 4.179
  92 .
  93 write;
  94 EOF
  95             "format() does not look at LC_NUMERIC without 'use locale'");
  96
  97         {
  98             fresh_perl_is(<<'EOF', $difference, {},
  99 use locale;
 100 format STDOUT =
 101 @.#
 102 4.179
 103 .
 104 write;
 105 EOF
 106             "format() looks at LC_NUMERIC with 'use locale'");
 107         }
 108
 109         {
 110             fresh_perl_is(<<'EOF', "4.2", {},
 111 format STDOUT =
 112 @.#
 113 4.179
 114 .
 115 { use locale; write; }
 116 EOF
 117             "too late to look at the locale at write() time");
 118         }
 119
 120         {
 121             fresh_perl_is(<<'EOF', $difference, {},
 122 use locale; format STDOUT =
 123 @.#
 124 4.179
 125 .
 126 { no locale; write; }
 127 EOF
 128             "too late to ignore the locale at write() time");
 129         }
 130     }
 131
 132     for ($different) {
 133         local $ENV{LC_NUMERIC} = $_;
 134         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
 135         fresh_perl_is(<<'EOF', "$difference "x4, {},
 136             use locale;
 137             use POSIX qw(locale_h);
 138             setlocale(LC_NUMERIC, "");
 139             my $in = 4.2;
 140             printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
 141 EOF
 142         "sprintf() and printf() look at LC_NUMERIC regardless of constant folding");
 143     }
 144 } # SKIP
 145
 146 sub last { 7 }