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