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