5 require './test.pl'; # for fresh_perl_is() etc
6 require './loc_tools.pl'; # to find locales
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".
17 eval { require POSIX; POSIX->import("locale_h") };
19 skip_all("could not load the POSIX module"); # running minitest?
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;
28 fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF',
29 use POSIX qw(locale_h);
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$/;
37 "", {}, "no locales where LC_NUMERIC breaks");
40 local $ENV{LC_NUMERIC};
41 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
42 fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF',
43 use POSIX qw(locale_h);
46 my $s = sprintf "%g", $in; # avoid any constant folding bugs
51 "", {}, "LC_NUMERIC without environment nor setlocale() has no effect in any locale");
54 # try to find out a locale where LC_NUMERIC makes a difference
55 my $original_locale = setlocale(LC_NUMERIC);
57 my ($base, $different, $comma, $difference);
58 for ("C", @locales) { # prefer C for the base if available
60 if($Config{d_setlocale}) {
61 require locale; import locale;
64 setlocale(LC_NUMERIC, $_) or next;
65 my $in = 4.2; # avoid any constant folding bugs
66 if ((my $s = sprintf("%g", $in)) eq "4.2") {
71 $comma ||= $_ if localeconv()->{decimal_point} eq ',';
74 last if $base && $different && $comma;
76 setlocale(LC_NUMERIC, $original_locale);
79 skip("no locale available where LC_NUMERIC makes a difference", &last - 2)
81 note("using the '$different' locale for LC_NUMERIC tests");
83 local $ENV{LC_NUMERIC} = $_;
84 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
86 fresh_perl_is(<<'EOF', "4.2", {},
93 "format() does not look at LC_NUMERIC without 'use locale'");
96 fresh_perl_is(<<'EOF', $difference, {},
104 "format() looks at LC_NUMERIC with 'use locale'");
108 fresh_perl_is(<<'EOF', $difference, {},
109 use locale ":not_characters";
116 "format() looks at LC_NUMERIC with 'use locale \":not_characters\"'");
120 fresh_perl_is(<<'EOF', "4.2", {},
125 { require locale; import locale; write; }
127 "too late to look at the locale at write() time");
131 fresh_perl_is(<<'EOF', $difference, {},
137 { no locale; write; }
139 "too late to ignore the locale at write() time");
144 # do not let "use 5.000" affect the locale!
145 # this test is to prevent regression of [rt.perl.org #105784]
146 fresh_perl_is(<<"EOF",
148 if("$Config{d_setlocale}") {
149 require locale; import locale;
154 POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
155 \$a = sprintf("%.2f", \$i);
157 \$b = sprintf("%.2f", \$i);
158 print ".\$a \$b" unless \$a eq \$b
160 "", {}, "version does not clobber version");
162 fresh_perl_is(<<"EOF",
166 POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
167 \$a = sprintf("%.2f", \$i);
169 \$b = sprintf("%.2f", \$i);
170 print "\$a \$b" unless \$a eq \$b
172 "", {}, "version does not clobber version (via eval)");
176 local $ENV{LC_NUMERIC} = $_;
177 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
178 fresh_perl_is(<<'EOF', "$difference "x4, {},
180 use POSIX qw(locale_h);
181 setlocale(LC_NUMERIC, "");
183 printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
185 "sprintf() and printf() look at LC_NUMERIC regardless of constant folding");
189 local $ENV{LC_ALL} = "invalid";
190 local $ENV{LC_NUMERIC} = "invalid";
191 local $ENV{LANG} = $_;
193 # Can't turn off the warnings, so send them to /dev/null
194 fresh_perl_is(<<'EOF', "$difference", { stderr => "devnull" },
196 use POSIX qw(locale_h);
197 setlocale(LC_NUMERIC, "");
201 "LANG is used if LC_ALL, LC_NUMERIC are invalid");
205 if ($^O eq 'MSWin32') {
206 skip("Win32 uses system default locale in preference to \"C\"", 1);
210 local $ENV{LC_ALL} = "invalid";
211 local $ENV{LC_NUMERIC} = "invalid";
212 local $ENV{LANG} = "invalid";
214 # Can't turn off the warnings, so send them to /dev/null
215 fresh_perl_is(<<'EOF', 4.2, { stderr => "devnull" },
217 use POSIX qw(locale_h);
218 setlocale(LC_NUMERIC, "");
222 'C locale is used if LC_ALL, LC_NUMERIC, LANG are invalid');
228 local $ENV{LC_NUMERIC} = $_;
229 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
230 fresh_perl_is(<<"EOF",
231 use POSIX qw(locale_h);
233 BEGIN { setlocale(LC_NUMERIC, \"$_\"); };
234 setlocale(LC_ALL, "C");
236 print setlocale(LC_NUMERIC);
239 "No compile error on v-strings when setting the locale to non-dot radix at compile time when default environment has non-dot radix");
243 skip("no locale available where LC_NUMERIC is a comma", 3);
247 fresh_perl_is(<<"EOF",
252 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
257 "1,5\n1.5", {}, "Radix print properly in locale scope, and without");
259 fresh_perl_is(<<"EOF",
260 my \$i = 1.5; # Should be exactly representable as a base 2
261 # fraction, so can use 'eq' below
264 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
269 "1,5\n2,5", {}, "Can do math when radix is a comma"); # [perl 115800]
271 unless ($have_strtod) {
272 skip("no strtod()", 1);
275 fresh_perl_is(<<"EOF",
277 POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma");
278 my \$one_point_5 = POSIX::strtod("1,5");
279 \$one_point_5 =~ s/0+\$//; # Remove any trailing zeros
280 print \$one_point_5, "\n";
282 "1.5", {}, "POSIX::strtod() uses underlying locale");
287 fresh_perl_is(<<"EOF",
290 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
291 print "h" =~ /[g\\w]/i || 0;
294 1, {}, "/il matching of [bracketed] doesn't skip POSIX class if fails individ char");
298 fresh_perl_is(<<"EOF",
301 POSIX::setlocale(POSIX::LC_CTYPE(),"C");
302 print "0" =~ /[\\d[:punct:]]/l || 0;
305 1, {}, "/l matching of [bracketed] doesn't skip non-first POSIX class");