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