This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
locale.c: Tighten what is considered a LC variable
[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 12# These tests are here instead of lib/locale.t because
05760874 13# some bugs depend on 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';
cd1f7080 24my @locales = find_locales( [ 'LC_ALL', 'LC_CTYPE', 'LC_NUMERIC' ]);
9c6df44e
NT
25skip_all("no locales available") unless @locales;
26
c53481e7 27# reset the locale environment
d5e32b93 28delete local @ENV{'LANG', (grep /^LC_[A-Z]+$/, keys %ENV)};
c53481e7 29
9c6df44e 30plan tests => &last;
49efabc8 31
a7fa5053 32my $non_C_locale;
49efabc8 33foreach my $locale (@locales) {
a7fa5053
KW
34 next if $locale eq "C" || $locale eq 'POSIX';
35 $non_C_locale = $locale;
49efabc8
KW
36 last;
37}
38
a7fa5053
KW
39SKIP: {
40 skip("no non-C locale available", 2 ) unless $non_C_locale;
41 setlocale(LC_NUMERIC, $non_C_locale);
42 isnt(setlocale(LC_NUMERIC), "C", "retrieving current non-C LC_NUMERIC doesn't give 'C'");
43 setlocale(LC_ALL, $non_C_locale);
44 isnt(setlocale(LC_ALL), "C", "retrieving current non-C LC_ALL doesn't give 'C'");
45}
46
dc51aebe
KW
47# Skip this locale on these cywgwin versions as the returned radix character
48# length is wrong
49my @test_numeric_locales = ($^O ne 'cygwin' || version->new(($Config{'osvers'} =~ /^(\d+(?:\.\d+)+)/)[0]) gt v2.4.1)
50 ? @locales
51 : grep { $_ !~ m/ps_AF/i } @locales;
52
53fresh_perl_is("for (qw(@test_numeric_locales)) {\n" . <<'EOF',
9c6df44e
NT
54 use POSIX qw(locale_h);
55 use locale;
56 setlocale(LC_NUMERIC, "$_") or next;
57 my $s = sprintf "%g %g", 3.1, 3.1;
58 next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/;
59 print "$_ $s\n";
60}
61EOF
62 "", {}, "no locales where LC_NUMERIC breaks");
63
e1df4071 64SKIP: {
2ebcba0a 65 skip("Windows stores locale defaults in the registry", 1 )
e1df4071 66 if $^O eq 'MSWin32';
5be9e824
KW
67 fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF',
68 use POSIX qw(locale_h);
69 use locale;
70 my $in = 4.2;
71 my $s = sprintf "%g", $in; # avoid any constant folding bugs
72 next if $s eq "4.2";
73 print "$_ $s\n";
74 }
903eb63f 75EOF
bc8ec7cc
KW
76 "", {}, "LC_NUMERIC without environment nor setlocale() has no effect in any locale");
77}
8d0b139e 78
903eb63f
NT
79# try to find out a locale where LC_NUMERIC makes a difference
80my $original_locale = setlocale(LC_NUMERIC);
81
c1284011
KW
82my ($base, $different, $comma, $difference, $utf8_radix);
83my $radix_encoded_as_utf8;
903eb63f 84for ("C", @locales) { # prefer C for the base if available
5f1269ab 85 use locale;
903eb63f
NT
86 setlocale(LC_NUMERIC, $_) or next;
87 my $in = 4.2; # avoid any constant folding bugs
88 if ((my $s = sprintf("%g", $in)) eq "4.2") {
89 $base ||= $_;
90 } else {
91 $different ||= $_;
92 $difference ||= $s;
c1284011
KW
93 my $radix = localeconv()->{decimal_point};
94
95 # For utf8 locales with a non-ascii radix, it should be encoded as
96 # UTF-8 with the internal flag so set.
97 if (! defined $utf8_radix
98 && $radix =~ /[[:^ascii:]]/
99 && is_locale_utf8($_))
100 {
101 $utf8_radix = $_;
102 $radix_encoded_as_utf8 = utf8::is_utf8($radix);
103 }
104 else {
105 $comma ||= $_ if $radix eq ',';
106 }
903eb63f
NT
107 }
108
c1284011 109 last if $base && $different && $comma && $utf8_radix;
903eb63f
NT
110}
111setlocale(LC_NUMERIC, $original_locale);
112
113SKIP: {
c1284011
KW
114 skip("no UTF-8 locale available where LC_NUMERIC radix isn't ASCII", 1 )
115 unless $utf8_radix;
116 ok($radix_encoded_as_utf8 == 1, "UTF-8 locale '$utf8_radix' with non-ASCII"
117 . " radix is marked UTF-8");
118}
119
120SKIP: {
a7fa5053
KW
121 skip("no locale available where LC_NUMERIC makes a difference", &last - 7 )
122 if !$different; # -7 is 5 tests before this block; 2 after
903eb63f 123 note("using the '$different' locale for LC_NUMERIC tests");
0ba5b45d
KW
124 {
125 local $ENV{LC_NUMERIC} = $different;
903eb63f
NT
126
127 fresh_perl_is(<<'EOF', "4.2", {},
128format STDOUT =
129@.#
1304.179
131.
132write;
133EOF
134 "format() does not look at LC_NUMERIC without 'use locale'");
135
136 {
d6ded950
KW
137 fresh_perl_is(<<'EOF', "$difference\n", {},
138use POSIX;
903eb63f
NT
139use locale;
140format STDOUT =
141@.#
1424.179
143.
144write;
145EOF
146 "format() looks at LC_NUMERIC with 'use locale'");
147 }
148
149 {
a835cd47 150 fresh_perl_is(<<'EOF', ",,", {},
a835cd47 151use POSIX;
98553364 152print localeconv()->{decimal_point};
a835cd47
KW
153use locale;
154print localeconv()->{decimal_point};
155EOF
156 "localeconv() looks at LC_NUMERIC with and without 'use locale'");
157 }
158
159 {
d6ded950
KW
160 my $categories = ":collate :characters :collate :ctype :monetary :time";
161 fresh_perl_is(<<"EOF", "4.2", {},
162use locale qw($categories);
163format STDOUT =
164@.#
1654.179
166.
167write;
168EOF
169 "format() does not look at LC_NUMERIC with 'use locale qw($categories)'");
170 }
171
172 {
173 fresh_perl_is(<<'EOF', $difference, {},
174use locale;
175format STDOUT =
176@.#
1774.179
178.
179write;
180EOF
181 "format() looks at LC_NUMERIC with 'use locale'");
182 }
183
184 for my $category (qw(collate characters collate ctype monetary time)) {
185 for my $negation ("!", "not_") {
186 fresh_perl_is(<<"EOF", $difference, {},
187use locale ":$negation$category";
188format STDOUT =
189@.#
1904.179
191.
192write;
193EOF
194 "format() looks at LC_NUMERIC with 'use locale \":"
195 . "$negation$category\"'");
196 }
197 }
198
199 {
b34856cb 200 fresh_perl_is(<<'EOF', $difference, {},
d6ded950 201use locale ":numeric";
b34856cb
KW
202format STDOUT =
203@.#
2044.179
205.
206write;
207EOF
d6ded950 208 "format() looks at LC_NUMERIC with 'use locale \":numeric\"'");
b34856cb
KW
209 }
210
211 {
903eb63f
NT
212 fresh_perl_is(<<'EOF', "4.2", {},
213format STDOUT =
214@.#
2154.179
216.
5f1269ab 217{ use locale; write; }
903eb63f
NT
218EOF
219 "too late to look at the locale at write() time");
220 }
221
222 {
223 fresh_perl_is(<<'EOF', $difference, {},
569f7fc5
JR
224use locale;
225format STDOUT =
903eb63f
NT
226@.#
2274.179
228.
229{ no locale; write; }
230EOF
231 "too late to ignore the locale at write() time");
232 }
233 }
b3fd6149 234
8d0b139e
RS
235 {
236 # do not let "use 5.000" affect the locale!
237 # this test is to prevent regression of [rt.perl.org #105784]
238 fresh_perl_is(<<"EOF",
5f1269ab 239 use locale;
8d0b139e
RS
240 use POSIX;
241 my \$i = 0.123;
242 POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
243 \$a = sprintf("%.2f", \$i);
244 require version;
245 \$b = sprintf("%.2f", \$i);
246 print ".\$a \$b" unless \$a eq \$b
247EOF
248 "", {}, "version does not clobber version");
249
250 fresh_perl_is(<<"EOF",
251 use locale;
252 use POSIX;
253 my \$i = 0.123;
254 POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
255 \$a = sprintf("%.2f", \$i);
256 eval "use v5.0.0";
257 \$b = sprintf("%.2f", \$i);
258 print "\$a \$b" unless \$a eq \$b
259EOF
260 "", {}, "version does not clobber version (via eval)");
261 }
262
0ba5b45d
KW
263 {
264 local $ENV{LC_NUMERIC} = $different;
b3fd6149 265 fresh_perl_is(<<'EOF', "$difference "x4, {},
6a188f46 266 use locale;
b3fd6149 267 use POSIX qw(locale_h);
b3fd6149
NT
268 my $in = 4.2;
269 printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
270EOF
271 "sprintf() and printf() look at LC_NUMERIC regardless of constant folding");
272 }
02aba72f 273
0ba5b45d
KW
274 {
275 local $ENV{LC_NUMERIC} = $different;
481465ea
KW
276 fresh_perl_is(<<'EOF', "$difference "x4, {},
277 use locale;
278 use POSIX qw(locale_h);
481465ea
KW
279 my $in = 4.2;
280 printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
281EOF
282 "Uses the above test to verify that on Windows the system default locale has lower priority than LC_NUMERIC");
283 }
284
ff4377fe
DM
285
286 # within this block, STDERR is closed. This is because fresh_perl_is()
287 # forks a shell, and some shells (like bash) can complain noisily when
1da50240 288 # LC_ALL or similar is set to an invalid value
ff4377fe
DM
289
290 {
291 open my $saved_stderr, ">&STDERR" or die "Can't dup STDERR: $!";
292 close STDERR;
293
0ba5b45d 294 {
250680e3
DM
295 local $ENV{LC_ALL} = "invalid";
296 local $ENV{LC_NUMERIC} = "invalid";
0ba5b45d 297 local $ENV{LANG} = $different;
62fe37a7 298 local $ENV{PERL_BADLANG} = 0;
65ebb059 299
62fe37a7 300 if (! fresh_perl_is(<<"EOF", "$difference", { },
e9a5eef6
KW
301 if (\$ENV{LC_ALL} ne "invalid") {
302 # Make the test pass if the sh didn't accept the ENV set
303 print "$difference\n";
304 exit 0;
305 }
250680e3
DM
306 use locale;
307 use POSIX qw(locale_h);
e9a5eef6
KW
308 my \$in = 4.2;
309 printf("%g", \$in);
65ebb059 310EOF
10225cc4
KW
311 "LANG is used if LC_ALL, LC_NUMERIC are invalid"))
312 {
6d04d1e9 313 note "To see details change this .t, do not close STDERR";
10225cc4 314 }
65ebb059 315 }
65ebb059 316
250680e3
DM
317 SKIP: {
318 if ($^O eq 'MSWin32') {
319 skip("Win32 uses system default locale in preference to \"C\"",
320 1);
321 }
322 else {
68021d02
KW
323 local $ENV{LC_ALL} = "invalid";
324 local $ENV{LC_NUMERIC} = "invalid";
325 local $ENV{LANG} = "invalid";
62fe37a7 326 local $ENV{PERL_BADLANG} = 0;
250680e3 327
62fe37a7 328 if (! fresh_perl_is(<<"EOF", 4.2, { },
68021d02
KW
329 if (\$ENV{LC_ALL} ne "invalid") {
330 print "$difference\n";
331 exit 0;
332 }
333 use locale;
334 use POSIX qw(locale_h);
68021d02
KW
335 my \$in = 4.2;
336 printf("%g", \$in);
65ebb059 337EOF
10225cc4
KW
338 'C locale is used if LC_ALL, LC_NUMERIC, LANG are invalid'))
339 {
6d04d1e9 340 note "To see details change this .t, do not close STDERR";
10225cc4 341 }
65ebb059
KW
342 }
343 }
65ebb059 344
ff4377fe
DM
345 open STDERR, ">&", $saved_stderr or die "Can't dup \$saved_stderr: $!";
346 }
347
0ba5b45d
KW
348 {
349 local $ENV{LC_NUMERIC} = $different;
bc8ec7cc
KW
350 fresh_perl_is(<<"EOF",
351 use POSIX qw(locale_h);
352
0ba5b45d 353 BEGIN { setlocale(LC_NUMERIC, \"$different\"); };
bc8ec7cc
KW
354 setlocale(LC_ALL, "C");
355 use 5.008;
356 print setlocale(LC_NUMERIC);
357EOF
cd0b934e 358 "C", { stderr => 'devnull' },
bc8ec7cc
KW
359 "No compile error on v-strings when setting the locale to non-dot radix at compile time when default environment has non-dot radix");
360 }
361
02aba72f 362 unless ($comma) {
65ebb059 363 skip("no locale available where LC_NUMERIC is a comma", 3);
02aba72f
KW
364 }
365 else {
366
367 fresh_perl_is(<<"EOF",
368 my \$i = 1.5;
369 {
370 use locale;
371 use POSIX;
372 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
373 print \$i, "\n";
374 }
375 print \$i, "\n";
376EOF
cd0b934e 377 "1,5\n1.5", { stderr => 'devnull' }, "Radix print properly in locale scope, and without");
02aba72f
KW
378
379 fresh_perl_is(<<"EOF",
380 my \$i = 1.5; # Should be exactly representable as a base 2
381 # fraction, so can use 'eq' below
382 use locale;
383 use POSIX;
384 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
385 print \$i, "\n";
386 \$i += 1;
387 print \$i, "\n";
388EOF
cd0b934e 389 "1,5\n2,5", { stderr => 'devnull' }, "Can do math when radix is a comma"); # [perl 115800]
371d5d44
KW
390
391 unless ($have_strtod) {
392 skip("no strtod()", 1);
393 }
394 else {
395 fresh_perl_is(<<"EOF",
396 use POSIX;
397 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
398 my \$one_point_5 = POSIX::strtod("1,5");
399 \$one_point_5 =~ s/0+\$//; # Remove any trailing zeros
400 print \$one_point_5, "\n";
401EOF
cd0b934e 402 "1.5", { stderr => 'devnull' }, "POSIX::strtod() uses underlying locale");
371d5d44 403 }
02aba72f 404 }
11220351 405} # SKIP
02aba72f 406
ee48a02a
KW
407 {
408 fresh_perl_is(<<"EOF",
409 use locale;
410 use POSIX;
411 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
412 print "h" =~ /[g\\w]/i || 0;
413 print "\\n";
414EOF
cd0b934e 415 1, { stderr => 'devnull' }, "/il matching of [bracketed] doesn't skip POSIX class if fails individ char");
ee48a02a
KW
416 }
417
6e79ab66
KW
418 {
419 fresh_perl_is(<<"EOF",
420 use locale;
421 use POSIX;
422 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
423 print "0" =~ /[\\d[:punct:]]/l || 0;
424 print "\\n";
425EOF
cd0b934e 426 1, { stderr => 'devnull' }, "/l matching of [bracketed] doesn't skip non-first POSIX class");
6e79ab66
KW
427
428 }
429
a7fa5053
KW
430# IMPORTANT: When adding tests before the following line, be sure to update
431# its skip count:
432# skip("no locale available where LC_NUMERIC makes a difference", ...)
49efabc8 433sub last { 37 }