This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/run/locale.t: Skip some tests for some shells
[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
02aba72f 58my ($base, $different, $comma, $difference);
903eb63f 59for ("C", @locales) { # prefer C for the base if available
569f7fc5
JR
60 BEGIN {
61 if($Config{d_setlocale}) {
62 require locale; import locale;
63 }
64 }
903eb63f
NT
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;
02aba72f 72 $comma ||= $_ if localeconv()->{decimal_point} eq ',';
903eb63f
NT
73 }
74
02aba72f 75 last if $base && $different && $comma;
903eb63f
NT
76}
77setlocale(LC_NUMERIC, $original_locale);
78
79SKIP: {
eda602ad
KW
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
903eb63f 82 note("using the '$different' locale for LC_NUMERIC tests");
0ba5b45d
KW
83 {
84 local $ENV{LC_NUMERIC} = $different;
903eb63f
NT
85 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
86
87 fresh_perl_is(<<'EOF', "4.2", {},
88format STDOUT =
89@.#
904.179
91.
92write;
93EOF
94 "format() does not look at LC_NUMERIC without 'use locale'");
95
96 {
97 fresh_perl_is(<<'EOF', $difference, {},
98use locale;
99format STDOUT =
100@.#
1014.179
102.
103write;
104EOF
105 "format() looks at LC_NUMERIC with 'use locale'");
106 }
107
108 {
b34856cb
KW
109 fresh_perl_is(<<'EOF', $difference, {},
110use locale ":not_characters";
111format STDOUT =
112@.#
1134.179
114.
115write;
116EOF
117 "format() looks at LC_NUMERIC with 'use locale \":not_characters\"'");
118 }
119
120 {
903eb63f
NT
121 fresh_perl_is(<<'EOF', "4.2", {},
122format STDOUT =
123@.#
1244.179
125.
569f7fc5 126{ require locale; import locale; write; }
903eb63f
NT
127EOF
128 "too late to look at the locale at write() time");
129 }
130
131 {
132 fresh_perl_is(<<'EOF', $difference, {},
569f7fc5
JR
133use locale;
134format STDOUT =
903eb63f
NT
135@.#
1364.179
137.
138{ no locale; write; }
139EOF
140 "too late to ignore the locale at write() time");
141 }
142 }
b3fd6149 143
8d0b139e
RS
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",
569f7fc5 148 BEGIN {
23c6e7c9 149 if("$Config{d_setlocale}") {
569f7fc5
JR
150 require locale; import locale;
151 }
152 }
8d0b139e
RS
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
160EOF
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
172EOF
173 "", {}, "version does not clobber version (via eval)");
174 }
175
0ba5b45d
KW
176 {
177 local $ENV{LC_NUMERIC} = $different;
b3fd6149
NT
178 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
179 fresh_perl_is(<<'EOF', "$difference "x4, {},
6a188f46 180 use locale;
b3fd6149
NT
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));
185EOF
186 "sprintf() and printf() look at LC_NUMERIC regardless of constant folding");
187 }
02aba72f 188
0ba5b45d
KW
189 {
190 local $ENV{LC_NUMERIC} = $different;
481465ea
KW
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));
199EOF
200 "Uses the above test to verify that on Windows the system default locale has lower priority than LC_NUMERIC");
201 }
202
ff4377fe
DM
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
0ba5b45d 212 {
250680e3
DM
213 local $ENV{LC_ALL} = "invalid";
214 local $ENV{LC_NUMERIC} = "invalid";
0ba5b45d 215 local $ENV{LANG} = $different;
65ebb059 216
250680e3 217 # Can't turn off the warnings, so send them to /dev/null
e9a5eef6
KW
218 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 }
250680e3
DM
224 use locale;
225 use POSIX qw(locale_h);
226 setlocale(LC_NUMERIC, "");
e9a5eef6
KW
227 my \$in = 4.2;
228 printf("%g", \$in);
65ebb059 229EOF
250680e3 230 "LANG is used if LC_ALL, LC_NUMERIC are invalid");
65ebb059 231 }
65ebb059 232
250680e3
DM
233 SKIP: {
234 if ($^O eq 'MSWin32') {
235 skip("Win32 uses system default locale in preference to \"C\"",
236 1);
237 }
238 else {
0ba5b45d 239 {
250680e3
DM
240 local $ENV{LC_ALL} = "invalid";
241 local $ENV{LC_NUMERIC} = "invalid";
242 local $ENV{LANG} = "invalid";
243
244 # Can't turn off the warnings, so send them to /dev/null
e9a5eef6
KW
245 fresh_perl_is(<<"EOF", 4.2, { stderr => "devnull" },
246 if (\$ENV{LC_ALL} ne "invalid") {
247 print "$difference\n";
248 exit 0;
249 }
250680e3
DM
250 use locale;
251 use POSIX qw(locale_h);
252 setlocale(LC_NUMERIC, "");
e9a5eef6
KW
253 my \$in = 4.2;
254 printf("%g", \$in);
65ebb059 255EOF
250680e3
DM
256 'C locale is used if LC_ALL, LC_NUMERIC, LANG are invalid');
257 }
65ebb059
KW
258 }
259 }
65ebb059 260
ff4377fe
DM
261 open STDERR, ">&", $saved_stderr or die "Can't dup \$saved_stderr: $!";
262 }
263
0ba5b45d
KW
264 {
265 local $ENV{LC_NUMERIC} = $different;
bc8ec7cc
KW
266 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
267 fresh_perl_is(<<"EOF",
268 use POSIX qw(locale_h);
269
0ba5b45d 270 BEGIN { setlocale(LC_NUMERIC, \"$different\"); };
bc8ec7cc
KW
271 setlocale(LC_ALL, "C");
272 use 5.008;
273 print setlocale(LC_NUMERIC);
274EOF
275 "C", { },
276 "No compile error on v-strings when setting the locale to non-dot radix at compile time when default environment has non-dot radix");
277 }
278
02aba72f 279 unless ($comma) {
65ebb059 280 skip("no locale available where LC_NUMERIC is a comma", 3);
02aba72f
KW
281 }
282 else {
283
284 fresh_perl_is(<<"EOF",
285 my \$i = 1.5;
286 {
287 use locale;
288 use POSIX;
289 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
290 print \$i, "\n";
291 }
292 print \$i, "\n";
293EOF
294 "1,5\n1.5", {}, "Radix print properly in locale scope, and without");
295
296 fresh_perl_is(<<"EOF",
297 my \$i = 1.5; # Should be exactly representable as a base 2
298 # fraction, so can use 'eq' below
299 use locale;
300 use POSIX;
301 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
302 print \$i, "\n";
303 \$i += 1;
304 print \$i, "\n";
305EOF
306 "1,5\n2,5", {}, "Can do math when radix is a comma"); # [perl 115800]
371d5d44
KW
307
308 unless ($have_strtod) {
309 skip("no strtod()", 1);
310 }
311 else {
312 fresh_perl_is(<<"EOF",
313 use POSIX;
314 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
315 my \$one_point_5 = POSIX::strtod("1,5");
316 \$one_point_5 =~ s/0+\$//; # Remove any trailing zeros
317 print \$one_point_5, "\n";
318EOF
319 "1.5", {}, "POSIX::strtod() uses underlying locale");
320 }
02aba72f 321 }
11220351 322} # SKIP
02aba72f 323
ee48a02a
KW
324 {
325 fresh_perl_is(<<"EOF",
326 use locale;
327 use POSIX;
328 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
329 print "h" =~ /[g\\w]/i || 0;
330 print "\\n";
331EOF
332 1, {}, "/il matching of [bracketed] doesn't skip POSIX class if fails individ char");
333 }
334
6e79ab66
KW
335 {
336 fresh_perl_is(<<"EOF",
337 use locale;
338 use POSIX;
339 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
340 print "0" =~ /[\\d[:punct:]]/l || 0;
341 print "\\n";
342EOF
343 1, {}, "/l matching of [bracketed] doesn't skip non-first POSIX class");
344
345 }
346
481465ea 347sub last { 19 }