This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
6301734bb363117f4619931f920b36f6bdc02092
[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}; # So not taken as a default
41     local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
42     local $ENV{LANG};   # So not taken as a default
43     fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF',
44         use POSIX qw(locale_h);
45         use locale;
46         my $in = 4.2;
47         my $s = sprintf "%g", $in; # avoid any constant folding bugs
48         next if $s eq "4.2";
49         print "$_ $s\n";
50     }
51 EOF
52     "", {}, "LC_NUMERIC without environment nor setlocale() has no effect in any locale");
53 }
54
55 # try to find out a locale where LC_NUMERIC makes a difference
56 my $original_locale = setlocale(LC_NUMERIC);
57
58 my ($base, $different, $comma, $difference);
59 for ("C", @locales) { # prefer C for the base if available
60     BEGIN {
61         if($Config{d_setlocale}) {
62             require locale; import locale;
63         }
64     }
65     setlocale(LC_NUMERIC, $_) or next;
66     my $in = 4.2; # avoid any constant folding bugs
67     if ((my $s = sprintf("%g", $in)) eq "4.2")  {
68         $base ||= $_;
69     } else {
70         $different ||= $_;
71         $difference ||= $s;
72         $comma ||= $_ if localeconv()->{decimal_point} eq ',';
73     }
74
75     last if $base && $different && $comma;
76 }
77 setlocale(LC_NUMERIC, $original_locale);
78
79 SKIP: {
80     skip("no locale available where LC_NUMERIC makes a difference", &last - 4 )
81         if !$different;     # -4 is 2 tests before this block; 2 after
82     note("using the '$different' locale for LC_NUMERIC tests");
83     {
84         local $ENV{LC_NUMERIC} = $different;
85         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
86
87         fresh_perl_is(<<'EOF', "4.2", {},
88 format STDOUT =
89 @.#
90 4.179
91 .
92 write;
93 EOF
94             "format() does not look at LC_NUMERIC without 'use locale'");
95
96         {
97             fresh_perl_is(<<'EOF', $difference, {},
98 use locale;
99 format STDOUT =
100 @.#
101 4.179
102 .
103 write;
104 EOF
105             "format() looks at LC_NUMERIC with 'use locale'");
106         }
107
108         {
109             fresh_perl_is(<<'EOF', $difference, {},
110 use locale ":not_characters";
111 format STDOUT =
112 @.#
113 4.179
114 .
115 write;
116 EOF
117             "format() looks at LC_NUMERIC with 'use locale \":not_characters\"'");
118         }
119
120         {
121             fresh_perl_is(<<'EOF', "4.2", {},
122 format STDOUT =
123 @.#
124 4.179
125 .
126 { require locale; import locale; write; }
127 EOF
128             "too late to look at the locale at write() time");
129         }
130
131         {
132             fresh_perl_is(<<'EOF', $difference, {},
133 use locale;
134 format STDOUT =
135 @.#
136 4.179
137 .
138 { no locale; write; }
139 EOF
140             "too late to ignore the locale at write() time");
141         }
142     }
143
144     {
145         # do not let "use 5.000" affect the locale!
146         # this test is to prevent regression of [rt.perl.org #105784]
147         fresh_perl_is(<<"EOF",
148             BEGIN {
149                 if("$Config{d_setlocale}") {
150                     require locale; import locale;
151                 }
152             }
153             use POSIX;
154             my \$i = 0.123;
155             POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
156             \$a = sprintf("%.2f", \$i);
157             require version;
158             \$b = sprintf("%.2f", \$i);
159             print ".\$a \$b" unless \$a eq \$b
160 EOF
161             "", {}, "version does not clobber version");
162
163         fresh_perl_is(<<"EOF",
164             use locale;
165             use POSIX;
166             my \$i = 0.123;
167             POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
168             \$a = sprintf("%.2f", \$i);
169             eval "use v5.0.0";
170             \$b = sprintf("%.2f", \$i);
171             print "\$a \$b" unless \$a eq \$b
172 EOF
173             "", {}, "version does not clobber version (via eval)");
174     }
175
176     {
177         local $ENV{LC_NUMERIC} = $different;
178         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
179         fresh_perl_is(<<'EOF', "$difference "x4, {},
180             use locale;
181             use POSIX qw(locale_h);
182             setlocale(LC_NUMERIC, "");
183             my $in = 4.2;
184             printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
185 EOF
186         "sprintf() and printf() look at LC_NUMERIC regardless of constant folding");
187     }
188
189     {
190         local $ENV{LC_NUMERIC} = $different;
191         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
192         local $ENV{LANG};   # so on Windows gets sys default locale
193         fresh_perl_is(<<'EOF', "$difference "x4, {},
194             use locale;
195             use POSIX qw(locale_h);
196             setlocale(LC_NUMERIC, "");
197             my $in = 4.2;
198             printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
199 EOF
200         "Uses the above test to verify that on Windows the system default locale has lower priority than LC_NUMERIC");
201     }
202
203
204     # within this block, STDERR is closed. This is because fresh_perl_is()
205     # forks a shell, and some shells (like bash) can complain noisily when
206     #LC_ALL or similar is set to an invalid value
207
208     {
209         open my $saved_stderr, ">&STDERR" or die "Can't dup STDERR: $!";
210         close STDERR;
211
212         {
213             local $ENV{LC_ALL} = "invalid";
214             local $ENV{LC_NUMERIC} = "invalid";
215             local $ENV{LANG} = $different;
216
217             # Can't turn off the warnings, so send them to /dev/null
218             if (! fresh_perl_is(<<"EOF", "$difference", { stderr => "devnull" },
219                 if (\$ENV{LC_ALL} ne "invalid") {
220                     # Make the test pass if the sh didn't accept the ENV set
221                     print "$difference\n";
222                     exit 0;
223                 }
224                 use locale;
225                 use POSIX qw(locale_h);
226                 setlocale(LC_NUMERIC, "");
227                 my \$in = 4.2;
228                 printf("%g", \$in);
229 EOF
230             "LANG is used if LC_ALL, LC_NUMERIC are invalid"))
231            {
232               note "To see details change this .t to not close STDERR";
233            }
234         }
235
236         SKIP: {
237             if ($^O eq 'MSWin32') {
238                 skip("Win32 uses system default locale in preference to \"C\"",
239                         1);
240             }
241             else {
242                 local $ENV{LC_ALL} = "invalid";
243                 local $ENV{LC_NUMERIC} = "invalid";
244                 local $ENV{LANG} = "invalid";
245
246                 # Can't turn off the warnings, so send them to /dev/null
247                 if (! fresh_perl_is(<<"EOF", 4.2, { stderr => "devnull" },
248                     if (\$ENV{LC_ALL} ne "invalid") {
249                         print "$difference\n";
250                         exit 0;
251                     }
252                     use locale;
253                     use POSIX qw(locale_h);
254                     setlocale(LC_NUMERIC, "");
255                     my \$in = 4.2;
256                     printf("%g", \$in);
257 EOF
258                 'C locale is used if LC_ALL, LC_NUMERIC, LANG are invalid'))
259                 {
260                     note "To see details change this .t to not close STDERR";
261                 }
262             }
263         }
264
265     open STDERR, ">&", $saved_stderr or die "Can't dup \$saved_stderr: $!";
266     }
267
268     {
269         local $ENV{LC_NUMERIC} = $different;
270         local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
271         fresh_perl_is(<<"EOF",
272             use POSIX qw(locale_h);
273
274             BEGIN { setlocale(LC_NUMERIC, \"$different\"); };
275             setlocale(LC_ALL, "C");
276             use 5.008;
277             print setlocale(LC_NUMERIC);
278 EOF
279          "C", { },
280          "No compile error on v-strings when setting the locale to non-dot radix at compile time when default environment has non-dot radix");
281     }
282
283     unless ($comma) {
284         skip("no locale available where LC_NUMERIC is a comma", 3);
285     }
286     else {
287
288         fresh_perl_is(<<"EOF",
289             my \$i = 1.5;
290             {
291                 use locale;
292                 use POSIX;
293                 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
294                 print \$i, "\n";
295             }
296             print \$i, "\n";
297 EOF
298             "1,5\n1.5", {}, "Radix print properly in locale scope, and without");
299
300         fresh_perl_is(<<"EOF",
301             my \$i = 1.5;   # Should be exactly representable as a base 2
302                             # fraction, so can use 'eq' below
303             use locale;
304             use POSIX;
305             POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
306             print \$i, "\n";
307             \$i += 1;
308             print \$i, "\n";
309 EOF
310             "1,5\n2,5", {}, "Can do math when radix is a comma"); # [perl 115800]
311
312         unless ($have_strtod) {
313             skip("no strtod()", 1);
314         }
315         else {
316             fresh_perl_is(<<"EOF",
317                 use POSIX;
318                 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
319                 my \$one_point_5 = POSIX::strtod("1,5");
320                 \$one_point_5 =~ s/0+\$//;  # Remove any trailing zeros
321                 print \$one_point_5, "\n";
322 EOF
323             "1.5", {}, "POSIX::strtod() uses underlying locale");
324         }
325     }
326 } # SKIP
327
328     {
329         fresh_perl_is(<<"EOF",
330                 use locale;
331                 use POSIX;
332                 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
333                 print "h" =~ /[g\\w]/i || 0;
334                 print "\\n";
335 EOF
336             1, {}, "/il matching of [bracketed] doesn't skip POSIX class if fails individ char");
337     }
338
339     {
340         fresh_perl_is(<<"EOF",
341                 use locale;
342                 use POSIX;
343                 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
344                 print "0" =~ /[\\d[:punct:]]/l || 0;
345                 print "\\n";
346 EOF
347             1, {}, "/l matching of [bracketed] doesn't skip non-first POSIX class");
348
349     }
350
351 sub last { 19 }