This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Improve fallback during locale initialization
[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     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 = eval { 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_ALL} = "invalid";
190         local $ENV{LC_NUMERIC} = "invalid";
191         local $ENV{LANG} = $_;
192
193         # Can't turn off the warnings, so send them to /dev/null
194         fresh_perl_is(<<'EOF', "$difference", { stderr => "devnull" },
195         use locale;
196             use POSIX qw(locale_h);
197             setlocale(LC_NUMERIC, "");
198             my $in = 4.2;
199             printf("%g", $in);
200 EOF
201         "LANG is used if LC_ALL, LC_NUMERIC are invalid");
202     }
203
204     SKIP: {
205         if ($^O eq 'MSWin32') {
206             skip("Win32 uses system default locale in preference to \"C\"", 1);
207         }
208         else {
209             for ($different) {
210                 local $ENV{LC_ALL} = "invalid";
211                 local $ENV{LC_NUMERIC} = "invalid";
212                 local $ENV{LANG} = "invalid";
213
214                 # Can't turn off the warnings, so send them to /dev/null
215                 fresh_perl_is(<<'EOF', 4.2, { stderr => "devnull" },
216                 use locale;
217                     use POSIX qw(locale_h);
218                     setlocale(LC_NUMERIC, "");
219                     my $in = 4.2;
220                     printf("%g", $in);
221 EOF
222                 'C locale is used if LC_ALL, LC_NUMERIC, LANG are invalid');
223             }
224         }
225     }
226
227     for ($different) {
228         local $ENV{LC_NUMERIC} = $_;
229         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
230         fresh_perl_is(<<"EOF",
231             use POSIX qw(locale_h);
232
233             BEGIN { setlocale(LC_NUMERIC, \"$_\"); };
234             setlocale(LC_ALL, "C");
235             use 5.008;
236             print setlocale(LC_NUMERIC);
237 EOF
238          "C", { },
239          "No compile error on v-strings when setting the locale to non-dot radix at compile time when default environment has non-dot radix");
240     }
241
242     unless ($comma) {
243         skip("no locale available where LC_NUMERIC is a comma", 3);
244     }
245     else {
246
247         fresh_perl_is(<<"EOF",
248             my \$i = 1.5;
249             {
250                 use locale;
251                 use POSIX;
252                 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
253                 print \$i, "\n";
254             }
255             print \$i, "\n";
256 EOF
257             "1,5\n1.5", {}, "Radix print properly in locale scope, and without");
258
259         fresh_perl_is(<<"EOF",
260             my \$i = 1.5;   # Should be exactly representable as a base 2
261                             # fraction, so can use 'eq' below
262             use locale;
263             use POSIX;
264             POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
265             print \$i, "\n";
266             \$i += 1;
267             print \$i, "\n";
268 EOF
269             "1,5\n2,5", {}, "Can do math when radix is a comma"); # [perl 115800]
270
271         unless ($have_strtod) {
272             skip("no strtod()", 1);
273         }
274         else {
275             fresh_perl_is(<<"EOF",
276                 use POSIX;
277                 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
278                 my \$one_point_5 = POSIX::strtod("1,5");
279                 \$one_point_5 =~ s/0+\$//;  # Remove any trailing zeros
280                 print \$one_point_5, "\n";
281 EOF
282             "1.5", {}, "POSIX::strtod() uses underlying locale");
283         }
284     }
285
286     {
287         fresh_perl_is(<<"EOF",
288                 use locale;
289                 use POSIX;
290                 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
291                 print "h" =~ /[g\\w]/i || 0;
292                 print "\\n";
293 EOF
294             1, {}, "/il matching of [bracketed] doesn't skip POSIX class if fails individ char");
295     }
296
297     {
298         fresh_perl_is(<<"EOF",
299                 use locale;
300                 use POSIX;
301                 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
302                 print "0" =~ /[\\d[:punct:]]/l || 0;
303                 print "\\n";
304 EOF
305             1, {}, "/l matching of [bracketed] doesn't skip non-first POSIX class");
306
307     }
308
309
310 } # SKIP
311
312 sub last { 18 }