This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/run/locale.t: Remove unnecessary setlocales()
[perl5.git] / t / run / locale.t
CommitLineData
9c6df44e
NT
1#!./perl
2BEGIN {
3 chdir 't' if -d 't';
4 @INC = '../lib';
5 require './test.pl'; # for fresh_perl_is() etc
a5dfa8d3 6 require './loc_tools.pl'; # to find locales
9c6df44e
NT
7}
8
9use strict;
10
11########
903eb63f
NT
12# These tests are here instead of lib/locale.t because
13# some bugs depend on in the internal state of the locale
9c6df44e 14# settings and pragma/locale messes up that state pretty badly.
903eb63f 15# We need "fresh runs".
9c6df44e 16BEGIN {
903eb63f 17 eval { require POSIX; POSIX->import("locale_h") };
9c6df44e
NT
18 if ($@) {
19 skip_all("could not load the POSIX module"); # running minitest?
20 }
21}
22use Config;
371d5d44 23my $have_strtod = $Config{d_strtod} eq 'define';
46f4bdef 24my @locales = eval { find_locales( [ &LC_ALL, &LC_CTYPE, &LC_NUMERIC ] ) };
9c6df44e
NT
25skip_all("no locales available") unless @locales;
26
27plan tests => &last;
28fresh_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}
36EOF
37 "", {}, "no locales where LC_NUMERIC breaks");
38
bc8ec7cc 39{
95683ed0 40 local $ENV{LC_NUMERIC}; # So not taken as a default
bc8ec7cc 41 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
95683ed0 42 local $ENV{LANG}; # So not taken as a default
5be9e824
KW
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 }
903eb63f 51EOF
bc8ec7cc
KW
52 "", {}, "LC_NUMERIC without environment nor setlocale() has no effect in any locale");
53}
8d0b139e 54
903eb63f
NT
55# try to find out a locale where LC_NUMERIC makes a difference
56my $original_locale = setlocale(LC_NUMERIC);
57
c1284011
KW
58my ($base, $different, $comma, $difference, $utf8_radix);
59my $radix_encoded_as_utf8;
903eb63f 60for ("C", @locales) { # prefer C for the base if available
5f1269ab 61 use locale;
903eb63f
NT
62 setlocale(LC_NUMERIC, $_) or next;
63 my $in = 4.2; # avoid any constant folding bugs
64 if ((my $s = sprintf("%g", $in)) eq "4.2") {
65 $base ||= $_;
66 } else {
67 $different ||= $_;
68 $difference ||= $s;
c1284011
KW
69 my $radix = localeconv()->{decimal_point};
70
71 # For utf8 locales with a non-ascii radix, it should be encoded as
72 # UTF-8 with the internal flag so set.
73 if (! defined $utf8_radix
74 && $radix =~ /[[:^ascii:]]/
75 && is_locale_utf8($_))
76 {
77 $utf8_radix = $_;
78 $radix_encoded_as_utf8 = utf8::is_utf8($radix);
79 }
80 else {
81 $comma ||= $_ if $radix eq ',';
82 }
903eb63f
NT
83 }
84
c1284011 85 last if $base && $different && $comma && $utf8_radix;
903eb63f
NT
86}
87setlocale(LC_NUMERIC, $original_locale);
88
89SKIP: {
c1284011
KW
90 skip("no UTF-8 locale available where LC_NUMERIC radix isn't ASCII", 1 )
91 unless $utf8_radix;
92 ok($radix_encoded_as_utf8 == 1, "UTF-8 locale '$utf8_radix' with non-ASCII"
93 . " radix is marked UTF-8");
94}
95
96SKIP: {
97 skip("no locale available where LC_NUMERIC makes a difference", &last - 5 )
98 if !$different; # -5 is 3 tests before this block; 2 after
903eb63f 99 note("using the '$different' locale for LC_NUMERIC tests");
0ba5b45d
KW
100 {
101 local $ENV{LC_NUMERIC} = $different;
903eb63f
NT
102 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
103
104 fresh_perl_is(<<'EOF', "4.2", {},
105format STDOUT =
106@.#
1074.179
108.
109write;
110EOF
111 "format() does not look at LC_NUMERIC without 'use locale'");
112
113 {
d6ded950
KW
114 fresh_perl_is(<<'EOF', "$difference\n", {},
115use POSIX;
903eb63f
NT
116use locale;
117format STDOUT =
118@.#
1194.179
120.
121write;
122EOF
123 "format() looks at LC_NUMERIC with 'use locale'");
124 }
125
126 {
a835cd47
KW
127 fresh_perl_is(<<'EOF', ",,", {},
128print localeconv()->{decimal_point};
129use POSIX;
130use locale;
131print localeconv()->{decimal_point};
132EOF
133 "localeconv() looks at LC_NUMERIC with and without 'use locale'");
134 }
135
136 {
d6ded950
KW
137 my $categories = ":collate :characters :collate :ctype :monetary :time";
138 fresh_perl_is(<<"EOF", "4.2", {},
139use locale qw($categories);
140format STDOUT =
141@.#
1424.179
143.
144write;
145EOF
146 "format() does not look at LC_NUMERIC with 'use locale qw($categories)'");
147 }
148
149 {
150 fresh_perl_is(<<'EOF', $difference, {},
151use locale;
152format STDOUT =
153@.#
1544.179
155.
156write;
157EOF
158 "format() looks at LC_NUMERIC with 'use locale'");
159 }
160
161 for my $category (qw(collate characters collate ctype monetary time)) {
162 for my $negation ("!", "not_") {
163 fresh_perl_is(<<"EOF", $difference, {},
164use locale ":$negation$category";
165format STDOUT =
166@.#
1674.179
168.
169write;
170EOF
171 "format() looks at LC_NUMERIC with 'use locale \":"
172 . "$negation$category\"'");
173 }
174 }
175
176 {
b34856cb 177 fresh_perl_is(<<'EOF', $difference, {},
d6ded950 178use locale ":numeric";
b34856cb
KW
179format STDOUT =
180@.#
1814.179
182.
183write;
184EOF
d6ded950 185 "format() looks at LC_NUMERIC with 'use locale \":numeric\"'");
b34856cb
KW
186 }
187
188 {
903eb63f
NT
189 fresh_perl_is(<<'EOF', "4.2", {},
190format STDOUT =
191@.#
1924.179
193.
5f1269ab 194{ use locale; write; }
903eb63f
NT
195EOF
196 "too late to look at the locale at write() time");
197 }
198
199 {
200 fresh_perl_is(<<'EOF', $difference, {},
569f7fc5
JR
201use locale;
202format STDOUT =
903eb63f
NT
203@.#
2044.179
205.
206{ no locale; write; }
207EOF
208 "too late to ignore the locale at write() time");
209 }
210 }
b3fd6149 211
8d0b139e
RS
212 {
213 # do not let "use 5.000" affect the locale!
214 # this test is to prevent regression of [rt.perl.org #105784]
215 fresh_perl_is(<<"EOF",
5f1269ab 216 use locale;
8d0b139e
RS
217 use POSIX;
218 my \$i = 0.123;
219 POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
220 \$a = sprintf("%.2f", \$i);
221 require version;
222 \$b = sprintf("%.2f", \$i);
223 print ".\$a \$b" unless \$a eq \$b
224EOF
225 "", {}, "version does not clobber version");
226
227 fresh_perl_is(<<"EOF",
228 use locale;
229 use POSIX;
230 my \$i = 0.123;
231 POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
232 \$a = sprintf("%.2f", \$i);
233 eval "use v5.0.0";
234 \$b = sprintf("%.2f", \$i);
235 print "\$a \$b" unless \$a eq \$b
236EOF
237 "", {}, "version does not clobber version (via eval)");
238 }
239
0ba5b45d
KW
240 {
241 local $ENV{LC_NUMERIC} = $different;
b3fd6149
NT
242 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
243 fresh_perl_is(<<'EOF', "$difference "x4, {},
6a188f46 244 use locale;
b3fd6149 245 use POSIX qw(locale_h);
b3fd6149
NT
246 my $in = 4.2;
247 printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
248EOF
249 "sprintf() and printf() look at LC_NUMERIC regardless of constant folding");
250 }
02aba72f 251
0ba5b45d
KW
252 {
253 local $ENV{LC_NUMERIC} = $different;
481465ea
KW
254 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
255 local $ENV{LANG}; # so on Windows gets sys default locale
256 fresh_perl_is(<<'EOF', "$difference "x4, {},
257 use locale;
258 use POSIX qw(locale_h);
481465ea
KW
259 my $in = 4.2;
260 printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
261EOF
262 "Uses the above test to verify that on Windows the system default locale has lower priority than LC_NUMERIC");
263 }
264
ff4377fe
DM
265
266 # within this block, STDERR is closed. This is because fresh_perl_is()
267 # forks a shell, and some shells (like bash) can complain noisily when
268 #LC_ALL or similar is set to an invalid value
269
270 {
271 open my $saved_stderr, ">&STDERR" or die "Can't dup STDERR: $!";
272 close STDERR;
273
0ba5b45d 274 {
250680e3
DM
275 local $ENV{LC_ALL} = "invalid";
276 local $ENV{LC_NUMERIC} = "invalid";
0ba5b45d 277 local $ENV{LANG} = $different;
65ebb059 278
250680e3 279 # Can't turn off the warnings, so send them to /dev/null
10225cc4 280 if (! fresh_perl_is(<<"EOF", "$difference", { stderr => "devnull" },
e9a5eef6
KW
281 if (\$ENV{LC_ALL} ne "invalid") {
282 # Make the test pass if the sh didn't accept the ENV set
283 print "$difference\n";
284 exit 0;
285 }
250680e3
DM
286 use locale;
287 use POSIX qw(locale_h);
e9a5eef6
KW
288 my \$in = 4.2;
289 printf("%g", \$in);
65ebb059 290EOF
10225cc4
KW
291 "LANG is used if LC_ALL, LC_NUMERIC are invalid"))
292 {
293 note "To see details change this .t to not close STDERR";
294 }
65ebb059 295 }
65ebb059 296
250680e3
DM
297 SKIP: {
298 if ($^O eq 'MSWin32') {
299 skip("Win32 uses system default locale in preference to \"C\"",
300 1);
301 }
302 else {
68021d02
KW
303 local $ENV{LC_ALL} = "invalid";
304 local $ENV{LC_NUMERIC} = "invalid";
305 local $ENV{LANG} = "invalid";
250680e3 306
68021d02 307 # Can't turn off the warnings, so send them to /dev/null
10225cc4 308 if (! fresh_perl_is(<<"EOF", 4.2, { stderr => "devnull" },
68021d02
KW
309 if (\$ENV{LC_ALL} ne "invalid") {
310 print "$difference\n";
311 exit 0;
312 }
313 use locale;
314 use POSIX qw(locale_h);
68021d02
KW
315 my \$in = 4.2;
316 printf("%g", \$in);
65ebb059 317EOF
10225cc4
KW
318 'C locale is used if LC_ALL, LC_NUMERIC, LANG are invalid'))
319 {
320 note "To see details change this .t to not close STDERR";
321 }
65ebb059
KW
322 }
323 }
65ebb059 324
ff4377fe
DM
325 open STDERR, ">&", $saved_stderr or die "Can't dup \$saved_stderr: $!";
326 }
327
0ba5b45d
KW
328 {
329 local $ENV{LC_NUMERIC} = $different;
bc8ec7cc
KW
330 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
331 fresh_perl_is(<<"EOF",
332 use POSIX qw(locale_h);
333
0ba5b45d 334 BEGIN { setlocale(LC_NUMERIC, \"$different\"); };
bc8ec7cc
KW
335 setlocale(LC_ALL, "C");
336 use 5.008;
337 print setlocale(LC_NUMERIC);
338EOF
339 "C", { },
340 "No compile error on v-strings when setting the locale to non-dot radix at compile time when default environment has non-dot radix");
341 }
342
02aba72f 343 unless ($comma) {
65ebb059 344 skip("no locale available where LC_NUMERIC is a comma", 3);
02aba72f
KW
345 }
346 else {
347
348 fresh_perl_is(<<"EOF",
349 my \$i = 1.5;
350 {
351 use locale;
352 use POSIX;
353 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
354 print \$i, "\n";
355 }
356 print \$i, "\n";
357EOF
358 "1,5\n1.5", {}, "Radix print properly in locale scope, and without");
359
360 fresh_perl_is(<<"EOF",
361 my \$i = 1.5; # Should be exactly representable as a base 2
362 # fraction, so can use 'eq' below
363 use locale;
364 use POSIX;
365 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
366 print \$i, "\n";
367 \$i += 1;
368 print \$i, "\n";
369EOF
370 "1,5\n2,5", {}, "Can do math when radix is a comma"); # [perl 115800]
371d5d44
KW
371
372 unless ($have_strtod) {
373 skip("no strtod()", 1);
374 }
375 else {
376 fresh_perl_is(<<"EOF",
377 use POSIX;
378 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
379 my \$one_point_5 = POSIX::strtod("1,5");
380 \$one_point_5 =~ s/0+\$//; # Remove any trailing zeros
381 print \$one_point_5, "\n";
382EOF
383 "1.5", {}, "POSIX::strtod() uses underlying locale");
384 }
02aba72f 385 }
11220351 386} # SKIP
02aba72f 387
ee48a02a
KW
388 {
389 fresh_perl_is(<<"EOF",
390 use locale;
391 use POSIX;
392 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
393 print "h" =~ /[g\\w]/i || 0;
394 print "\\n";
395EOF
396 1, {}, "/il matching of [bracketed] doesn't skip POSIX class if fails individ char");
397 }
398
6e79ab66
KW
399 {
400 fresh_perl_is(<<"EOF",
401 use locale;
402 use POSIX;
403 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
404 print "0" =~ /[\\d[:punct:]]/l || 0;
405 print "\\n";
406EOF
407 1, {}, "/l matching of [bracketed] doesn't skip non-first POSIX class");
408
409 }
410
d6ded950 411sub last { 35 }