This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don't fold constants in sprintf() if locales are used
[perl5.git] / t / run / locale.t
CommitLineData
9c6df44e
NT
1#!./perl
2BEGIN {
3 chdir 't' if -d 't';
4 @INC = '../lib';
5 require './test.pl'; # for fresh_perl_is() etc
6}
7
8use 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 15BEGIN {
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}
21use Config;
22my $have_setlocale = $Config{d_setlocale} eq 'define';
23$have_setlocale = 0 if $@;
24# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
25# and mingw32 uses said silly CRT
26$have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i);
27skip_all("no setlocale available") unless $have_setlocale;
28my @locales;
29if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) {
30 while(<LOCALES>) {
31 chomp;
32 push(@locales, $_);
33 }
34 close(LOCALES);
35}
36skip_all("no locales available") unless @locales;
37
38plan tests => &last;
39fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF',
40 use POSIX qw(locale_h);
41 use locale;
42 setlocale(LC_NUMERIC, "$_") or next;
43 my $s = sprintf "%g %g", 3.1, 3.1;
44 next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/;
45 print "$_ $s\n";
46}
47EOF
48 "", {}, "no locales where LC_NUMERIC breaks");
49
903eb63f
NT
50fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF',
51 use POSIX qw(locale_h);
52 use locale;
53 my $in = 4.2;
54 my $s = sprintf "%g", $in; # avoid any constant folding bugs
55 next if $s eq "4.2";
56 print "$_ $s\n";
57}
58EOF
59 "", {}, "LC_NUMERIC without setlocale() has no effect in any locale");
60
61# try to find out a locale where LC_NUMERIC makes a difference
62my $original_locale = setlocale(LC_NUMERIC);
63
64my ($base, $different, $difference);
65for ("C", @locales) { # prefer C for the base if available
66 use locale;
67 setlocale(LC_NUMERIC, $_) or next;
68 my $in = 4.2; # avoid any constant folding bugs
69 if ((my $s = sprintf("%g", $in)) eq "4.2") {
70 $base ||= $_;
71 } else {
72 $different ||= $_;
73 $difference ||= $s;
74 }
75
76 last if $base && $different;
77}
78setlocale(LC_NUMERIC, $original_locale);
79
80SKIP: {
81 skip("no locale available where LC_NUMERIC makes a difference", &last - 2)
82 if !$different;
83 note("using the '$different' locale for LC_NUMERIC tests");
84 for ($different) {
85 local $ENV{LC_NUMERIC} = $_;
86 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
87
88 fresh_perl_is(<<'EOF', "4.2", {},
89format STDOUT =
90@.#
914.179
92.
93write;
94EOF
95 "format() does not look at LC_NUMERIC without 'use locale'");
96
97 {
98 fresh_perl_is(<<'EOF', $difference, {},
99use locale;
100format STDOUT =
101@.#
1024.179
103.
104write;
105EOF
106 "format() looks at LC_NUMERIC with 'use locale'");
107 }
108
109 {
110 fresh_perl_is(<<'EOF', "4.2", {},
111format STDOUT =
112@.#
1134.179
114.
115{ use locale; write; }
116EOF
117 "too late to look at the locale at write() time");
118 }
119
120 {
121 fresh_perl_is(<<'EOF', $difference, {},
122use locale; format STDOUT =
123@.#
1244.179
125.
126{ no locale; write; }
127EOF
128 "too late to ignore the locale at write() time");
129 }
130 }
b3fd6149
NT
131
132 for ($different) {
133 local $ENV{LC_NUMERIC} = $_;
134 local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
135 fresh_perl_is(<<'EOF', "$difference "x4, {},
136 use locale;
137 use POSIX qw(locale_h);
138 setlocale(LC_NUMERIC, "");
139 my $in = 4.2;
140 printf("%g %g %s %s ", $in, 4.2, sprintf("%g", $in), sprintf("%g", 4.2));
141EOF
142 "sprintf() and printf() look at LC_NUMERIC regardless of constant folding");
143 }
903eb63f
NT
144} # SKIP
145
b3fd6149 146sub last { 7 }