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 | |
6 | } | |
7 | ||
8 | use strict; | |
9 | ||
10 | ######## | |
903eb63f NT |
11 | # These tests are here instead of lib/locale.t because |
12 | # some bugs depend on in the internal state of the locale | |
9c6df44e | 13 | # settings and pragma/locale messes up that state pretty badly. |
903eb63f | 14 | # We need "fresh runs". |
9c6df44e | 15 | BEGIN { |
903eb63f | 16 | eval { require POSIX; POSIX->import("locale_h") }; |
9c6df44e NT |
17 | if ($@) { |
18 | skip_all("could not load the POSIX module"); # running minitest? | |
19 | } | |
20 | } | |
21 | use Config; | |
22 | my $have_setlocale = $Config{d_setlocale} eq 'define'; | |
371d5d44 | 23 | my $have_strtod = $Config{d_strtod} eq 'define'; |
9c6df44e NT |
24 | $have_setlocale = 0 if $@; |
25 | # Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1" | |
26 | # and mingw32 uses said silly CRT | |
27 | $have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i); | |
28 | skip_all("no setlocale available") unless $have_setlocale; | |
29 | my @locales; | |
30 | if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) { | |
31 | while(<LOCALES>) { | |
32 | chomp; | |
33 | push(@locales, $_); | |
34 | } | |
35 | close(LOCALES); | |
36 | } | |
37 | skip_all("no locales available") unless @locales; | |
38 | ||
39 | plan tests => &last; | |
40 | fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF', | |
41 | use POSIX qw(locale_h); | |
42 | use locale; | |
43 | setlocale(LC_NUMERIC, "$_") or next; | |
44 | my $s = sprintf "%g %g", 3.1, 3.1; | |
45 | next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/; | |
46 | print "$_ $s\n"; | |
47 | } | |
48 | EOF | |
49 | "", {}, "no locales where LC_NUMERIC breaks"); | |
50 | ||
bc8ec7cc KW |
51 | { |
52 | local $ENV{LC_NUMERIC}; | |
53 | local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC | |
5be9e824 KW |
54 | fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF', |
55 | use POSIX qw(locale_h); | |
56 | use locale; | |
57 | my $in = 4.2; | |
58 | my $s = sprintf "%g", $in; # avoid any constant folding bugs | |
59 | next if $s eq "4.2"; | |
60 | print "$_ $s\n"; | |
61 | } | |
903eb63f | 62 | EOF |
bc8ec7cc KW |
63 | "", {}, "LC_NUMERIC without environment nor setlocale() has no effect in any locale"); |
64 | } | |
8d0b139e | 65 | |
903eb63f NT |
66 | # try to find out a locale where LC_NUMERIC makes a difference |
67 | my $original_locale = setlocale(LC_NUMERIC); | |
68 | ||
02aba72f | 69 | my ($base, $different, $comma, $difference); |
903eb63f | 70 | for ("C", @locales) { # prefer C for the base if available |
569f7fc5 JR |
71 | BEGIN { |
72 | if($Config{d_setlocale}) { | |
73 | require locale; import locale; | |
74 | } | |
75 | } | |
903eb63f NT |
76 | setlocale(LC_NUMERIC, $_) or next; |
77 | my $in = 4.2; # avoid any constant folding bugs | |
78 | if ((my $s = sprintf("%g", $in)) eq "4.2") { | |
79 | $base ||= $_; | |
80 | } else { | |
81 | $different ||= $_; | |
82 | $difference ||= $s; | |
02aba72f | 83 | $comma ||= $_ if localeconv()->{decimal_point} eq ','; |
903eb63f NT |
84 | } |
85 | ||
02aba72f | 86 | last if $base && $different && $comma; |
903eb63f NT |
87 | } |
88 | setlocale(LC_NUMERIC, $original_locale); | |
89 | ||
90 | SKIP: { | |
91 | skip("no locale available where LC_NUMERIC makes a difference", &last - 2) | |
92 | if !$different; | |
93 | note("using the '$different' locale for LC_NUMERIC tests"); | |
94 | for ($different) { | |
95 | local $ENV{LC_NUMERIC} = $_; | |
96 | local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC | |
97 | ||
98 | fresh_perl_is(<<'EOF', "4.2", {}, | |
99 | format STDOUT = | |
100 | @.# | |
101 | 4.179 | |
102 | . | |
103 | write; | |
104 | EOF | |
105 | "format() does not look at LC_NUMERIC without 'use locale'"); | |
106 | ||
107 | { | |
108 | fresh_perl_is(<<'EOF', $difference, {}, | |
109 | use locale; | |
110 | format STDOUT = | |
111 | @.# | |
112 | 4.179 | |
113 | . | |
114 | write; | |
115 | EOF | |
116 | "format() looks at LC_NUMERIC with 'use locale'"); | |
117 | } | |
118 | ||
119 | { | |
b34856cb KW |
120 | fresh_perl_is(<<'EOF', $difference, {}, |
121 | use locale ":not_characters"; | |
122 | format STDOUT = | |
123 | @.# | |
124 | 4.179 | |
125 | . | |
126 | write; | |
127 | EOF | |
128 | "format() looks at LC_NUMERIC with 'use locale \":not_characters\"'"); | |
129 | } | |
130 | ||
131 | { | |
903eb63f NT |
132 | fresh_perl_is(<<'EOF', "4.2", {}, |
133 | format STDOUT = | |
134 | @.# | |
135 | 4.179 | |
136 | . | |
569f7fc5 | 137 | { require locale; import locale; write; } |
903eb63f NT |
138 | EOF |
139 | "too late to look at the locale at write() time"); | |
140 | } | |
141 | ||
142 | { | |
143 | fresh_perl_is(<<'EOF', $difference, {}, | |
569f7fc5 JR |
144 | use locale; |
145 | format STDOUT = | |
903eb63f NT |
146 | @.# |
147 | 4.179 | |
148 | . | |
149 | { no locale; write; } | |
150 | EOF | |
151 | "too late to ignore the locale at write() time"); | |
152 | } | |
153 | } | |
b3fd6149 | 154 | |
8d0b139e RS |
155 | { |
156 | # do not let "use 5.000" affect the locale! | |
157 | # this test is to prevent regression of [rt.perl.org #105784] | |
158 | fresh_perl_is(<<"EOF", | |
569f7fc5 | 159 | BEGIN { |
23c6e7c9 | 160 | if("$Config{d_setlocale}") { |
569f7fc5 JR |
161 | require locale; import locale; |
162 | } | |
163 | } | |
8d0b139e RS |
164 | use POSIX; |
165 | my \$i = 0.123; | |
166 | POSIX::setlocale(POSIX::LC_NUMERIC(),"$different"); | |
167 | \$a = sprintf("%.2f", \$i); | |
168 | require version; | |
169 | \$b = sprintf("%.2f", \$i); | |
170 | print ".\$a \$b" unless \$a eq \$b | |
171 | EOF | |
172 | "", {}, "version does not clobber version"); | |
173 | ||
174 | fresh_perl_is(<<"EOF", | |
175 | use locale; | |
176 | use POSIX; | |
177 | my \$i = 0.123; | |
178 | POSIX::setlocale(POSIX::LC_NUMERIC(),"$different"); | |
179 | \$a = sprintf("%.2f", \$i); | |
180 | eval "use v5.0.0"; | |
181 | \$b = sprintf("%.2f", \$i); | |
182 | print "\$a \$b" unless \$a eq \$b | |
183 | EOF | |
184 | "", {}, "version does not clobber version (via eval)"); | |
185 | } | |
186 | ||
b3fd6149 NT |
187 | for ($different) { |
188 | local $ENV{LC_NUMERIC} = $_; | |
189 | local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC | |
190 | fresh_perl_is(<<'EOF', "$difference "x4, {}, | |
569f7fc5 | 191 | use locale; |
b3fd6149 NT |
192 | use POSIX qw(locale_h); |
193 | setlocale(LC_NUMERIC, ""); | |
194 | my $in = 4.2; | |
195 | printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2)); | |
196 | EOF | |
197 | "sprintf() and printf() look at LC_NUMERIC regardless of constant folding"); | |
198 | } | |
02aba72f | 199 | |
bc8ec7cc KW |
200 | for ($different) { |
201 | local $ENV{LC_NUMERIC} = $_; | |
202 | local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC | |
203 | fresh_perl_is(<<"EOF", | |
204 | use POSIX qw(locale_h); | |
205 | ||
206 | BEGIN { setlocale(LC_NUMERIC, \"$_\"); }; | |
207 | setlocale(LC_ALL, "C"); | |
208 | use 5.008; | |
209 | print setlocale(LC_NUMERIC); | |
210 | EOF | |
211 | "C", { }, | |
212 | "No compile error on v-strings when setting the locale to non-dot radix at compile time when default environment has non-dot radix"); | |
213 | } | |
214 | ||
215 | for ($different) { | |
216 | local $ENV{LC_NUMERIC} = $_; | |
217 | local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC | |
218 | fresh_perl_is(<<"EOF", | |
219 | use POSIX qw(locale_h); | |
220 | ||
221 | BEGIN { print setlocale(LC_NUMERIC), "\n"; }; | |
222 | EOF | |
223 | $_, { }, | |
224 | "Passed in LC_NUMERIC is valid at compilation time"); | |
225 | } | |
226 | ||
02aba72f KW |
227 | unless ($comma) { |
228 | skip("no locale available where LC_NUMERIC is a comma", 2); | |
229 | } | |
230 | else { | |
231 | ||
232 | fresh_perl_is(<<"EOF", | |
233 | my \$i = 1.5; | |
234 | { | |
235 | use locale; | |
236 | use POSIX; | |
237 | POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma"); | |
238 | print \$i, "\n"; | |
239 | } | |
240 | print \$i, "\n"; | |
241 | EOF | |
242 | "1,5\n1.5", {}, "Radix print properly in locale scope, and without"); | |
243 | ||
244 | fresh_perl_is(<<"EOF", | |
245 | my \$i = 1.5; # Should be exactly representable as a base 2 | |
246 | # fraction, so can use 'eq' below | |
247 | use locale; | |
248 | use POSIX; | |
249 | POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma"); | |
250 | print \$i, "\n"; | |
251 | \$i += 1; | |
252 | print \$i, "\n"; | |
253 | EOF | |
254 | "1,5\n2,5", {}, "Can do math when radix is a comma"); # [perl 115800] | |
371d5d44 KW |
255 | |
256 | unless ($have_strtod) { | |
257 | skip("no strtod()", 1); | |
258 | } | |
259 | else { | |
260 | fresh_perl_is(<<"EOF", | |
261 | use POSIX; | |
262 | POSIX::setlocale(POSIX::LC_NUMERIC(),"$comma"); | |
263 | my \$one_point_5 = POSIX::strtod("1,5"); | |
264 | \$one_point_5 =~ s/0+\$//; # Remove any trailing zeros | |
265 | print \$one_point_5, "\n"; | |
266 | EOF | |
267 | "1.5", {}, "POSIX::strtod() uses underlying locale"); | |
268 | } | |
02aba72f KW |
269 | } |
270 | ||
903eb63f NT |
271 | } # SKIP |
272 | ||
bc8ec7cc | 273 | sub last { 15 } |