1BEGIN { 2 require '../../t/test.pl'; 3 require '../../t/loc_tools.pl'; # to find locales 4} 5 6use XS::APItest; 7use Config; 8 9skip_all("locales not available") unless locales_enabled(); 10 11my @locales = eval { find_locales( &LC_NUMERIC ) }; 12 13if (@locales) { 14 use POSIX; 15 no warnings; 16 use warnings 'locale'; 17 my $warning = ""; 18 local $SIG{__WARN__} = sub { $warning = shift; }; 19 # Choose a number unlikely to be a legal category 20 ok(! setlocale(1114112, $locales[0]), 21 "Fails to set an illegal category to a legal locale"); 22 like($warning, qr/Unknown locale category/i, 23 "And warns about the illegal category, using the proper warning" 24 . " category"); 25} 26 27my $comma_locale; 28for my $locale (@locales) { 29 use POSIX; 30 use locale; 31 setlocale(LC_NUMERIC, $locale) or next; 32 my $in = 4.2; # avoid any constant folding bugs 33 my $s = sprintf("%g", $in); 34 if ($s eq "4,2") { 35 $comma_locale = $locale; 36 last; 37 } 38} 39 40SKIP: { 41 if ($Config{usequadmath}) { 42 skip "no gconvert with usequadmath", 2; 43 } 44 is(test_Gconvert(4.179, 2), "4.2", "Gconvert doesn't recognize underlying locale outside 'use locale'"); 45 use locale; 46 is(test_Gconvert(4.179, 2), "4.2", "Gconvert doesn't recognize underlying locale inside 'use locale'"); 47 } 48 49sub check_in_bounds($$$) { 50 my ($value, $lower, $upper) = @_; 51 52 $value >= $lower && $value <= $upper 53} 54 55SKIP: { 56 # This checks that when switching to the global locale, the service that 57 # Perl provides of transparently dealing with locales that have a non-dot 58 # radix is turned off, but gets turned on again after a sync_locale(); 59 60 skip "no locale with a comma radix available", 5 unless $comma_locale; 61 62 my $global_locale = switch_to_global_and_setlocale(LC_NUMERIC, 63 $comma_locale); 64 # Can't do a compare of $global_locale and $comma_locale because what the 65 # system returns may be an alias. ALl we can do is test for 66 # success/failure 67 if (ok($global_locale, "Successfully switched to $comma_locale")) { 68 is(newSvNV("4.888"), 4, 69 "dot not recognized in global comma locale for SvNV"); 70 71 no warnings 'numeric'; # Otherwise get "Argument isn't numeric in 72 # subroutine entry" 73 74 is(check_in_bounds(newSvNV("4,888"), 4.88, 4.89), 1, 75 "comma recognized in global comma locale for SvNV"); 76 isnt(sync_locale, 0, 77 "sync_locale() returns that was in the global locale"); 78 79 is(check_in_bounds(newSvNV("4.888"), 4.88, 4.89), 1, 80 "dot recognized in perl-controlled comma locale for SvNV"); 81 } 82 else { 83 skip "Couldn't switch to $comma_locale", 4; 84 } 85} 86 87my %correct_C_responses = ( 88 # Entries that are undef could have varying returns 89 CODESET => undef, 90 CRNCYSTR => undef, 91 NOEXPR => undef, 92 NOSTR => undef, 93 RADIXCHAR => '.', 94 THOUSEP => '', 95 YESEXPR => undef, 96 YESSTR => undef, 97 ABDAY_1 => 'Sun', 98 ABDAY_2 => 'Mon', 99 ABDAY_3 => 'Tue', 100 ABDAY_4 => 'Wed', 101 ABDAY_5 => 'Thu', 102 ABDAY_6 => 'Fri', 103 ABDAY_7 => 'Sat', 104 ABMON_1 => 'Jan', 105 ABMON_2 => 'Feb', 106 ABMON_3 => 'Mar', 107 ABMON_4 => 'Apr', 108 ABMON_5 => 'May', 109 ABMON_6 => 'Jun', 110 ABMON_7 => 'Jul', 111 ABMON_8 => 'Aug', 112 ABMON_9 => 'Sep', 113 ABMON_10 => 'Oct', 114 ABMON_11 => 'Nov', 115 ABMON_12 => 'Dec', 116 ALT_DIGITS => undef, 117 AM_STR => 'AM', 118 CODESET => undef, 119 CRNCYSTR => undef, 120 DAY_1 => 'Sunday', 121 DAY_2 => 'Monday', 122 DAY_3 => 'Tuesday', 123 DAY_4 => 'Wednesday', 124 DAY_5 => 'Thursday', 125 DAY_6 => 'Friday', 126 DAY_7 => 'Saturday', 127 D_FMT => undef, 128 D_T_FMT => undef, 129 ERA => '', 130 ERA_D_FMT => undef, 131 ERA_D_T_FMT => undef, 132 ERA_T_FMT => undef, 133 MON_1 => 'January', 134 MON_2 => 'February', 135 MON_3 => 'March', 136 MON_4 => 'April', 137 MON_5 => 'May', 138 MON_6 => 'June', 139 MON_7 => 'July', 140 MON_8 => 'August', 141 MON_9 => 'September', 142 MON_10 => 'October', 143 MON_11 => 'November', 144 MON_12 => 'December', 145 NOEXPR => undef, 146 NOSTR => undef, 147 PM_STR => 'PM', 148 RADIXCHAR => '.', 149 THOUSEP => '', 150 T_FMT => undef, 151 T_FMT_AMPM => undef, 152 YESEXPR => undef, 153 YESSTR => undef, 154 _NL_ADDRESS_POSTAL_FMT => undef, 155 _NL_ADDRESS_COUNTRY_NAME => undef, 156 _NL_ADDRESS_COUNTRY_POST => undef, 157 _NL_ADDRESS_COUNTRY_AB2 => undef, 158 _NL_ADDRESS_COUNTRY_AB3 => undef, 159 _NL_ADDRESS_COUNTRY_CAR => undef, 160 _NL_ADDRESS_COUNTRY_NUM => 0, 161 _NL_ADDRESS_COUNTRY_ISBN => undef, 162 _NL_ADDRESS_LANG_NAME => undef, 163 _NL_ADDRESS_LANG_AB => undef, 164 _NL_ADDRESS_LANG_TERM => undef, 165 _NL_ADDRESS_LANG_LIB => undef, 166 _NL_IDENTIFICATION_TITLE => undef, 167 _NL_IDENTIFICATION_SOURCE => undef, 168 _NL_IDENTIFICATION_ADDRESS => undef, 169 _NL_IDENTIFICATION_CONTACT => undef, 170 _NL_IDENTIFICATION_EMAIL => undef, 171 _NL_IDENTIFICATION_TEL => undef, 172 _NL_IDENTIFICATION_FAX => undef, 173 _NL_IDENTIFICATION_LANGUAGE => undef, 174 _NL_IDENTIFICATION_TERRITORY => "ISO", 175 _NL_IDENTIFICATION_AUDIENCE => undef, 176 _NL_IDENTIFICATION_APPLICATION => undef, 177 _NL_IDENTIFICATION_ABBREVIATION => undef, 178 _NL_IDENTIFICATION_REVISION => undef, 179 _NL_IDENTIFICATION_DATE => undef, 180 _NL_IDENTIFICATION_CATEGORY => undef, 181 _NL_MEASUREMENT_MEASUREMENT => undef, 182 _NL_NAME_NAME_FMT => undef, 183 _NL_NAME_NAME_GEN => undef, 184 _NL_NAME_NAME_MR => undef, 185 _NL_NAME_NAME_MRS => undef, 186 _NL_NAME_NAME_MISS => undef, 187 _NL_NAME_NAME_MS => undef, 188 _NL_PAPER_HEIGHT => undef, 189 _NL_PAPER_WIDTH => undef, 190 _NL_TELEPHONE_TEL_INT_FMT => undef, 191 _NL_TELEPHONE_TEL_DOM_FMT => undef, 192 _NL_TELEPHONE_INT_SELECT => undef, 193 _NL_TELEPHONE_INT_PREFIX => undef, 194 ); 195 196my $hdr = "../../perl_langinfo.h"; 197open my $fh, "<", $hdr; 198$|=1; 199 200SKIP: { 201 skip "No LC_ALL", 1 unless locales_enabled('LC_ALL'); 202 203 use POSIX; 204 setlocale(LC_ALL, "C"); 205 eval "use I18N::Langinfo qw(langinfo RADIXCHAR); langinfo(RADIXCHAR)"; 206 my $has_nl_langinfo = $@ eq ""; 207 208 skip "Can't open $hdr for reading: $!", 1 unless $fh; 209 210 my %items; 211 212 # Find all the current items from the header, and their values. 213 # For non-nl_langinfo systems, those values are arbitrary negative numbers 214 # set in the header. Otherwise they are the nl_langinfo approved values, 215 # which for the moment is the item name. 216 # The relevant lines look like: # define YESSTR -54 217 while (<$fh>) { 218 chomp; 219 next unless / - \d+ $ /x; 220 s/ ^ \# \s* define \s*//x; 221 m/ (\S+) \s+ (.*) /x; 222 $items{$1} = ($has_nl_langinfo) 223 ? $1 # Yields 'YESSTR' 224 : $2; # Yields -54 225 } 226 227 # Get the translation from item name to numeric value. 228 I18N::Langinfo->import(keys %items) if $has_nl_langinfo; 229 230 foreach my $formal_item (sort keys %items) { 231 SKIP: 232 if (exists $correct_C_responses{$formal_item}) { 233 my $correct = $correct_C_responses{$formal_item}; 234 my $item = eval $items{$formal_item}; 235 skip "This platform apparently doesn't support $formal_item", 1 if $@; 236 my $result = test_Perl_langinfo($item); 237 if (defined $correct) { 238 is ($result, $correct, 239 "Returns expected value" . "('$correct') for $formal_item"); 240 } 241 elsif (defined $result) { 242 pass("Returns a value (in this case '$result') for $formal_item"); 243 } 244 else { 245 fail("Returned undef for $formal_item"); 246 } 247 } 248 } 249} 250 251@locales = eval { find_locales( &LC_TIME ) }; 252 253SKIP: { 254 skip("no LC_TIME locales available") unless @locales; 255 256 for my $locale (@locales) { 257 use POSIX 'strftime'; 258 use locale; 259 setlocale(LC_TIME, $locale) or next; 260 261 # This isn't guaranteed to find failing locales, as it is impractical 262 # to test all possible dates. But it is much better than no test at 263 # all 264 if (strftime('%c', 0, 0, , 12, 18, 11, 87) eq "") { 265 fail('strftime() built-in expansion factor works for all locales'); 266 diag("Failed for locale $locale"); 267 last; 268 } 269 } 270} 271 272done_testing(); 273