This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Change enum names for new locale function parameters
[perl5.git] / ext / XS-APItest / t / locale.t
CommitLineData
4c28b29c
KW
1BEGIN {
2 require '../../t/test.pl';
3 require '../../t/loc_tools.pl'; # to find locales
4}
5
6use XS::APItest;
507244c8 7use Config;
4c28b29c 8
629eeaee 9skip_all("locales not available") unless locales_enabled('LC_NUMERIC');
4c28b29c
KW
10
11my @locales = eval { find_locales( &LC_NUMERIC ) };
629eeaee 12skip_all("no LC_NUMERIC locales available") unless @locales;
4c28b29c
KW
13
14my $non_dot_locale;
15for (@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
26SKIP: {
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
35my %correct_C_responses = (
6d38b7d9 36 # Entries that are undef could have varying returns
f7416781
KW
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',
f7416781
KW
45 ABMON_2 => 'Feb',
46 ABMON_3 => 'Mar',
47 ABMON_4 => 'Apr',
48 ABMON_5 => 'May',
49 ABMON_6 => 'Jun',
50 ABMON_7 => 'Jul',
51 ABMON_8 => 'Aug',
52 ABMON_9 => 'Sep',
cb2a626d
KW
53 ABMON_10 => 'Oct',
54 ABMON_11 => 'Nov',
55 ABMON_12 => 'Dec',
a565fc68 56 ALT_DIGITS => undef,
f7416781 57 AM_STR => 'AM',
6d38b7d9
KW
58 CODESET => undef,
59 CRNCYSTR => undef,
f7416781
KW
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',
6d38b7d9
KW
67 D_FMT => undef,
68 D_T_FMT => undef,
f7416781 69 ERA => '',
6d38b7d9
KW
70 ERA_D_FMT => undef,
71 ERA_D_T_FMT => undef,
72 ERA_T_FMT => undef,
f7416781 73 MON_1 => 'January',
f7416781
KW
74 MON_2 => 'February',
75 MON_3 => 'March',
76 MON_4 => 'April',
77 MON_5 => 'May',
78 MON_6 => 'June',
79 MON_7 => 'July',
80 MON_8 => 'August',
81 MON_9 => 'September',
cb2a626d
KW
82 MON_10 => 'October',
83 MON_11 => 'November',
84 MON_12 => 'December',
6d38b7d9 85 NOEXPR => undef,
c1566110 86 NOSTR => undef,
f7416781
KW
87 PM_STR => 'PM',
88 RADIXCHAR => '.',
89 THOUSEP => '',
6d38b7d9
KW
90 T_FMT => undef,
91 T_FMT_AMPM => undef,
92 YESEXPR => undef,
c1566110 93 YESSTR => undef,
f7416781
KW
94 );
95
96my $hdr = "../../perl_langinfo.h";
97open my $fh, "<", $hdr;
98$|=1;
99
100SKIP: {
101 skip "No LC_ALL", 1 unless find_locales( &LC_ALL );
102
103 use POSIX;
104 setlocale(LC_ALL, "C");
105 eval "use I18N::Langinfo qw(langinfo RADIXCHAR); langinfo(RADIXCHAR)";
106 my $has_nl_langinfo = $@ eq "";
107
108 skip "Can't open $hdr for reading: $!", 1 unless $fh;
109
110 my %items;
111
112 # Find all the current items from the header, and their values.
113 # For non-nl_langinfo systems, those values are arbitrary negative numbers
114 # set in the header. Otherwise they are the nl_langinfo approved values,
115 # which for the moment is the item name.
4e6826bf 116 # The relevant lines look like: # define YESSTR -54
f7416781
KW
117 while (<$fh>) {
118 chomp;
119 next unless / - \d+ $ /x;
4e6826bf 120 s/ ^ \# \s* define \s*//x;
f7416781
KW
121 m/ (.*) \ (.*) /x;
122 $items{$1} = ($has_nl_langinfo)
6d38b7d9
KW
123 ? $1 # Yields 'YESSTR'
124 : $2; # Yields -54
f7416781
KW
125 }
126
127 # Get the translation from item name to numeric value.
128 I18N::Langinfo->import(keys %items) if $has_nl_langinfo;
129
570a6dbb
KW
130 foreach my $formal_item (sort keys %items) {
131 if (exists $correct_C_responses{$formal_item}) {
4806e6cd 132 my $correct = $correct_C_responses{$formal_item};
570a6dbb 133 my $item = eval $items{$formal_item};
6d38b7d9 134 skip "This platform apparently doesn't support $formal_item", 1 if $@;
9fa1876f 135 my $result = test_Perl_langinfo($item);
4806e6cd
KW
136 if (defined $correct) {
137 is ($result, $correct,
138 "Returns expected value" . "('$correct') for $formal_item");
6d38b7d9
KW
139 }
140 else {
9fa1876f
KW
141 ok (defined $result,
142 "Returns a value (in this case '$result') for $formal_item");
6d38b7d9 143 }
f7416781
KW
144 }
145 }
146}
147
148done_testing();