This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don't fold constants in sprintf() if locales are used
[perl5.git] / 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 }