Commit | Line | Data |
---|---|---|
4c28b29c KW |
1 | BEGIN { |
2 | require '../../t/test.pl'; | |
3 | require '../../t/loc_tools.pl'; # to find locales | |
4 | } | |
5 | ||
6 | use XS::APItest; | |
507244c8 | 7 | use Config; |
4c28b29c | 8 | |
629eeaee | 9 | skip_all("locales not available") unless locales_enabled('LC_NUMERIC'); |
4c28b29c KW |
10 | |
11 | my @locales = eval { find_locales( &LC_NUMERIC ) }; | |
629eeaee | 12 | skip_all("no LC_NUMERIC locales available") unless @locales; |
4c28b29c KW |
13 | |
14 | my $non_dot_locale; | |
15 | for (@locales) { | |
16 | use locale; | |
17 | setlocale(LC_NUMERIC, $_) or next; | |
18 | my $in = 4.2; # avoid any constant folding bugs | |
19 | if (sprintf("%g", $in) ne "4.2") { | |
20 | $non_dot_locale = $_; | |
21 | last; | |
22 | } | |
23 | } | |
24 | ||
4c28b29c | 25 | |
507244c8 JH |
26 | SKIP: { |
27 | if ($Config{usequadmath}) { | |
28 | skip "no gconvert with usequadmath", 2; | |
29 | } | |
30 | is(test_Gconvert(4.179, 2), "4.2", "Gconvert doesn't recognize underlying locale outside 'use locale'"); | |
31 | use locale; | |
32 | is(test_Gconvert(4.179, 2), "4.2", "Gconvert doesn't recognize underlying locale inside 'use locale'"); | |
33 | } | |
f7416781 KW |
34 | |
35 | my %correct_C_responses = ( | |
36 | # Commented out entries are ones which there is room for variation | |
37 | ABDAY_1 => 'Sun', | |
38 | ABDAY_2 => 'Mon', | |
39 | ABDAY_3 => 'Tue', | |
40 | ABDAY_4 => 'Wed', | |
41 | ABDAY_5 => 'Thu', | |
42 | ABDAY_6 => 'Fri', | |
43 | ABDAY_7 => 'Sat', | |
44 | ABMON_1 => 'Jan', | |
45 | ABMON_10 => 'Oct', | |
46 | ABMON_11 => 'Nov', | |
47 | ABMON_12 => 'Dec', | |
48 | ABMON_2 => 'Feb', | |
49 | ABMON_3 => 'Mar', | |
50 | ABMON_4 => 'Apr', | |
51 | ABMON_5 => 'May', | |
52 | ABMON_6 => 'Jun', | |
53 | ABMON_7 => 'Jul', | |
54 | ABMON_8 => 'Aug', | |
55 | ABMON_9 => 'Sep', | |
56 | ALT_DIGITS => '', | |
57 | AM_STR => 'AM', | |
58 | #CODESET => 'ANSI_X3.4-1968', | |
59 | #CRNCYSTR => '-', | |
60 | DAY_1 => 'Sunday', | |
61 | DAY_2 => 'Monday', | |
62 | DAY_3 => 'Tuesday', | |
63 | DAY_4 => 'Wednesday', | |
64 | DAY_5 => 'Thursday', | |
65 | DAY_6 => 'Friday', | |
66 | DAY_7 => 'Saturday', | |
67 | #D_FMT => '%m/%d/%y', | |
68 | #D_T_FMT => '%a %b %e %H:%M:%S %Y', | |
69 | ERA => '', | |
70 | #ERA_D_FMT => '', | |
71 | #ERA_D_T_FMT => '', | |
72 | #ERA_T_FMT => '', | |
73 | MON_1 => 'January', | |
74 | MON_10 => 'October', | |
75 | MON_11 => 'November', | |
76 | MON_12 => 'December', | |
77 | MON_2 => 'February', | |
78 | MON_3 => 'March', | |
79 | MON_4 => 'April', | |
80 | MON_5 => 'May', | |
81 | MON_6 => 'June', | |
82 | MON_7 => 'July', | |
83 | MON_8 => 'August', | |
84 | MON_9 => 'September', | |
85 | #NOEXPR => '^[nN]', | |
86 | PM_STR => 'PM', | |
87 | RADIXCHAR => '.', | |
88 | THOUSEP => '', | |
89 | #T_FMT => '%H:%M:%S', | |
90 | #T_FMT_AMPM => '%I:%M:%S %p', | |
91 | #YESEXPR => '^[yY]', | |
92 | ); | |
93 | ||
94 | my $hdr = "../../perl_langinfo.h"; | |
95 | open my $fh, "<", $hdr; | |
96 | $|=1; | |
97 | ||
98 | SKIP: { | |
99 | skip "No LC_ALL", 1 unless find_locales( &LC_ALL ); | |
100 | ||
101 | use POSIX; | |
102 | setlocale(LC_ALL, "C"); | |
103 | eval "use I18N::Langinfo qw(langinfo RADIXCHAR); langinfo(RADIXCHAR)"; | |
104 | my $has_nl_langinfo = $@ eq ""; | |
105 | ||
106 | skip "Can't open $hdr for reading: $!", 1 unless $fh; | |
107 | ||
108 | my %items; | |
109 | ||
110 | # Find all the current items from the header, and their values. | |
111 | # For non-nl_langinfo systems, those values are arbitrary negative numbers | |
112 | # set in the header. Otherwise they are the nl_langinfo approved values, | |
113 | # which for the moment is the item name. | |
114 | while (<$fh>) { | |
115 | chomp; | |
116 | next unless / - \d+ $ /x; | |
117 | s/ ^ .* PERL_//x; | |
118 | m/ (.*) \ (.*) /x; | |
119 | $items{$1} = ($has_nl_langinfo) | |
120 | ? $1 | |
121 | : $2; | |
122 | } | |
123 | ||
124 | # Get the translation from item name to numeric value. | |
125 | I18N::Langinfo->import(keys %items) if $has_nl_langinfo; | |
126 | ||
570a6dbb KW |
127 | foreach my $formal_item (sort keys %items) { |
128 | if (exists $correct_C_responses{$formal_item}) { | |
129 | my $item = eval $items{$formal_item}; | |
130 | next if $@; | |
131 | is (test_Perl_langinfo($item), | |
132 | $correct_C_responses{$formal_item}, | |
133 | "Returns expected value for $formal_item"); | |
f7416781 KW |
134 | } |
135 | } | |
136 | } | |
137 | ||
138 | done_testing(); |