This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make pack-as-int/sprintf-%c-ing/chr-ring inf/nan fatal.
[perl5.git] / t / op / infnan.t
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 use strict;
10
11 use Config;
12
13 BEGIN {
14     if ($^O eq 'aix' && $Config{uselongdouble}) {
15         # FWIW: NaN actually seems to be working decently,
16         # but Inf is completely broken (e.g. Inf + 0 -> NaN).
17         skip_all "$^O with long doubles does not have sane inf/nan";
18     }
19 }
20
21 my $PInf = "Inf"  + 0;
22 my $NInf = "-Inf" + 0;
23 my $NaN  = "NaN"  + 0;
24
25 my @PInf = ("Inf", "inf", "INF", "+Inf",
26             "Infinity", "INFINITE",
27             "1.#INF", "1#INF");
28 my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf;
29
30 my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
31            "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND",
32            "NaN123", "NAN(123)", "nan%",
33            "nanonano"); # RIP, Robin Williams.
34
35 my @printf_fmt = qw(e f g a d u o i b x p);
36 my @packi_fmt = qw(a A Z b B h H c C s S l L i I n N v V j J w W p P u U);
37 my @packf_fmt = qw(f d F);
38
39 if ($Config{ivsize} == 8) {
40     push @packi_fmt, qw(q Q);
41 }
42
43 if ($Config{uselongdouble}) {
44     push @packf_fmt, 'D';
45 }
46
47 # === Inf tests ===
48
49 cmp_ok($PInf, '>', 0, "positive infinity");
50 cmp_ok($NInf, '<', 0, "negative infinity");
51
52 cmp_ok($PInf, '>', $NInf, "positive > negative");
53 cmp_ok($NInf, '==', -$PInf, "negative == -positive");
54 cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
55
56 is($PInf,  "Inf", "$PInf value stringifies as Inf");
57 is($NInf, "-Inf", "$NInf value stringifies as -Inf");
58
59 cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
60 cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
61
62 cmp_ok($PInf + 1, '==', $PInf, "Inf + one is Inf");
63 cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
64
65 is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
66 is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
67
68 for my $f (@printf_fmt) {
69     is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
70 }
71
72 ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
73 like($@, qr/Cannot printf/, "$PInf sprintf fails");
74
75 ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
76 like($@, qr/Cannot chr/, "+Inf chr() fails");
77
78 ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
79 like($@, qr/Cannot printf/, "$NInf sprintf fails");
80
81 ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
82 like($@, qr/Cannot chr/, "-Inf chr() fails");
83
84 for my $f (@packi_fmt) {
85     ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef");
86     like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
87          "+Inf pack $f fails");
88     ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef");
89     like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
90          "-Inf pack $f fails");
91 }
92
93 for my $f (@packf_fmt) {
94     ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
95     eval { $b = unpack($f, $a) };
96     cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf");
97
98     ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
99     eval { $b = unpack($f, $a) };
100     cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf");
101 }
102
103 for my $i (@PInf) {
104     cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
105     cmp_ok($i, '>', 0, "$i is positive");
106     is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
107 }
108
109 for my $i (@NInf) {
110     cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
111     cmp_ok($i, '<', 0, "$i is negative");
112     is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
113 }
114
115 is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf");
116 is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf");
117
118 is(1/$PInf, 0, "one per +Inf is zero");
119 is(1/$NInf, 0, "one per -Inf is zero");
120
121 my ($PInfPP, $PInfMM) = ($PInf, $PInf);
122 my ($NInfPP, $NInfMM) = ($NInf, $NInf);;
123 $PInfPP++;
124 $PInfMM--;
125 $NInfPP++;
126 $NInfMM--;
127 is($PInfPP, $PInf, "+Inf++ is +Inf");
128 is($PInfMM, $PInf, "+Inf-- is +Inf");
129 is($NInfPP, $NInf, "-Inf++ is -Inf");
130 is($NInfMM, $NInf, "-Inf-- is -Inf");
131
132 ok($PInf, "+Inf is true");
133 ok($NInf, "-Inf is true");
134
135 is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf");
136 is(exp($PInf), $PInf, "exp(+Inf) is +Inf");
137 is(exp($NInf), 0, "exp(-Inf) is zero");
138
139 SKIP: {
140     my $here = "$^O $Config{osvers}";
141     if ($here =~ /^hpux 10/) {
142         skip "$here: pow doesn't generate Inf", 1;
143     }
144     is(9**9**9, $PInf, "9**9**9 is Inf");
145 }
146
147 SKIP: {
148     my @FInf = qw(Info Infiniti Infinityz);
149     if ($Config{usequadmath}) {
150         skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
151     }
152     # Silence "isn't numeric in addition", that's kind of the point.
153     local $^W = 0;
154     for my $i (@FInf) {
155         cmp_ok("$i" + 0, '==', 0, "false infinity $i");
156     }
157 }
158
159 # === NaN ===
160
161 cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
162 ok($NaN eq $NaN, "NaN is NaN stringifically");
163
164 is("$NaN", "NaN", "$NaN value stringifies as NaN");
165
166 is("+NaN" + 0, "NaN", "+NaN is NaN");
167 is("-NaN" + 0, "NaN", "-NaN is NaN");
168
169 is($NaN * 2, $NaN, "twice NaN is NaN");
170 is($NaN / 2, $NaN, "half of NaN is NaN");
171
172 is($NaN + 1, $NaN, "NaN + one is NaN");
173
174 for my $f (@printf_fmt) {
175     is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
176 }
177
178 ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
179 like($@, qr/Cannot printf/, "$NaN sprintf fails");
180
181 ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
182 like($@, qr/Cannot chr/, "NaN chr() fails");
183
184 for my $f (@packi_fmt) {
185     ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef");
186     like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
187          "NaN pack $f fails");
188 }
189
190 for my $f (@packf_fmt) {
191     ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
192     eval { $b = unpack($f, $a) };
193     cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN");
194 }
195
196 for my $i (@NaN) {
197     cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
198     is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
199 }
200
201 ok(!($NaN <  0), "NaN is not lt zero");
202 ok(!($NaN == 0), "NaN is not == zero");
203 ok(!($NaN >  0), "NaN is not gt zero");
204
205 ok(!($NaN < $NaN), "NaN is not lt NaN");
206 ok(!($NaN > $NaN), "NaN is not gt NaN");
207
208 # is() okay with $NaN because it uses eq.
209 is($NaN * 0, $NaN, "NaN times zero is NaN");
210 is($NaN * 2, $NaN, "NaN times two is NaN");
211
212 my ($NaNPP, $NaNMM) = ($NaN, $NaN);
213 $NaNPP++;
214 $NaNMM--;
215 is($NaNPP, $NaN, "+Inf++ is +Inf");
216 is($NaNMM, $NaN, "+Inf-- is +Inf");
217
218 # You might find this surprising (isn't NaN kind of like of undef?)
219 # but this is how it is.
220 ok($NaN, "NaN is true");
221
222 is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN");
223 is(exp($NaN), $NaN, "exp(NaN) is NaN");
224 is(sin($NaN), $NaN, "sin(NaN) is NaN");
225
226 SKIP: {
227     my $here = "$^O $Config{osvers}";
228     if ($here =~ /^hpux 10/) {
229         skip "$here: pow doesn't generate Inf, so sin(Inf) won't happen", 1;
230     }
231     is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
232 }
233
234 # === Tests combining Inf and NaN ===
235
236 # is() okay with $NaN because it uses eq.
237 is($PInf * 0,     $NaN, "Inf times zero is NaN");
238 is($PInf * $NaN,  $NaN, "Inf times NaN is NaN");
239 is($PInf + $NaN,  $NaN, "Inf plus NaN is NaN");
240 is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
241 is($PInf / $PInf, $NaN, "Inf div inf is NaN");
242 is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
243
244 ok(!($NaN <  $PInf), "NaN is not lt +Inf");
245 ok(!($NaN == $PInf), "NaN is not eq +Inf");
246 ok(!($NaN >  $PInf), "NaN is not gt +Inf");
247
248 ok(!($NaN >  $NInf), "NaN is not lt -Inf");
249 ok(!($NaN == $NInf), "NaN is not eq -Inf");
250 ok(!($NaN <  $NInf), "NaN is not gt -Inf");
251
252 is(sin($PInf), $NaN, "sin(+Inf) is NaN");
253
254 done_testing();