This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
23d53776da8e08ac97bc26078aac03d2d8a7ac7b
[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(c C s S l L i I n N v V j J w W U);
37 my @packf_fmt = qw(f d F);
38 my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u);
39
40 if ($Config{ivsize} == 8) {
41     push @packi_fmt, qw(q Q);
42 }
43
44 if ($Config{uselongdouble} && $Config{nvsize} > $Config{doublesize}) {
45     push @packf_fmt, 'D';
46 }
47
48 # === Inf tests ===
49
50 cmp_ok($PInf, '>', 0, "positive infinity");
51 cmp_ok($NInf, '<', 0, "negative infinity");
52
53 cmp_ok($PInf, '>', $NInf, "positive > negative");
54 cmp_ok($NInf, '==', -$PInf, "negative == -positive");
55 cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
56
57 is($PInf,  "Inf", "$PInf value stringifies as Inf");
58 is($NInf, "-Inf", "$NInf value stringifies as -Inf");
59
60 cmp_ok($PInf + 0, '==', $PInf, "+Inf + zero is +Inf");
61 cmp_ok($NInf + 0, '==', $NInf, "-Inf + zero is -Inf");
62
63 cmp_ok($PInf + 1, '==', $PInf, "+Inf + one is +Inf");
64 cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
65
66 cmp_ok($PInf + $PInf, '==', $PInf, "+Inf + Inf is +Inf");
67 cmp_ok($NInf + $NInf, '==', $NInf, "-Inf - Inf is -Inf");
68
69 cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
70 cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
71
72 cmp_ok($PInf * $PInf, '==', $PInf, "+Inf * +Inf is +Inf");
73 cmp_ok($PInf * $NInf, '==', $NInf, "+Inf * -Inf is -Inf");
74 cmp_ok($NInf * $PInf, '==', $NInf, "-Inf * +Inf is -Inf");
75 cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf");
76
77 is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
78 is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
79
80 for my $f (@printf_fmt) {
81     is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
82 }
83
84 ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
85 like($@, qr/Cannot printf/, "$PInf sprintf fails");
86 ok(!defined eval { $a = sprintf("%c", "Inf")},
87   "stringy sprintf %c +Inf undef");
88 like($@, qr/Cannot printf/, "stringy $PInf sprintf fails");
89
90 ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
91 like($@, qr/Cannot chr/, "+Inf chr() fails");
92 ok(!defined eval { $a = chr("Inf") }, "chr(stringy +Inf) undef");
93 like($@, qr/Cannot chr/, "stringy +Inf chr() fails");
94
95 ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
96 like($@, qr/Cannot printf/, "$NInf sprintf fails");
97 ok(!defined eval { $a = sprintf("%c", "-Inf")},
98   "sprintf %c stringy -Inf undef");
99 like($@, qr/Cannot printf/, "stringy $NInf sprintf fails");
100
101 ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
102 like($@, qr/Cannot chr/, "-Inf chr() fails");
103 ok(!defined eval { $a = chr("-Inf") }, "chr(stringy -Inf) undef");
104 like($@, qr/Cannot chr/, "stringy -Inf chr() fails");
105
106 for my $f (@packi_fmt) {
107     undef $a;
108     ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef");
109     like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
110          "+Inf pack $f fails");
111     undef $a;
112     ok(!defined eval { $a = pack($f, "Inf") },
113       "pack $f stringy +Inf undef");
114     like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
115          "stringy +Inf pack $f fails");
116     undef $a;
117     ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef");
118     like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
119          "-Inf pack $f fails");
120     undef $a;
121     ok(!defined eval { $a = pack($f, "-Inf") },
122       "pack $f stringy -Inf undef");
123     like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
124          "stringy -Inf pack $f fails");
125 }
126
127 for my $f (@packf_fmt) {
128     undef $a;
129     undef $b;
130     ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
131     eval { $b = unpack($f, $a) };
132     cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf");
133
134     undef $a;
135     undef $b;
136     ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
137     eval { $b = unpack($f, $a) };
138     cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf");
139 }
140
141 for my $f (@packs_fmt) {
142     undef $a;
143     ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
144     is($a, pack($f, "Inf"), "pack $f +Inf same as 'Inf'");
145
146     undef $a;
147     ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
148     is($a, pack($f, "-Inf"), "pack $f -Inf same as 'Inf'");
149 }
150
151 is eval { unpack "p", pack 'p', $PInf }, "Inf", "pack p +Inf";
152 is eval { unpack "P3", pack 'P', $PInf }, "Inf", "pack P +Inf";
153 is eval { unpack "p", pack 'p', $NInf }, "-Inf", "pack p -Inf";
154 is eval { unpack "P4", pack 'P', $NInf }, "-Inf", "pack P -Inf";
155
156 for my $i (@PInf) {
157     cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
158     cmp_ok($i, '>', 0, "$i is positive");
159     is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
160 }
161
162 for my $i (@NInf) {
163     cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
164     cmp_ok($i, '<', 0, "$i is negative");
165     is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
166 }
167
168 is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf");
169 is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf");
170
171 is(1/$PInf, 0, "one per +Inf is zero");
172 is(1/$NInf, 0, "one per -Inf is zero");
173
174 my ($PInfPP, $PInfMM) = ($PInf, $PInf);
175 my ($NInfPP, $NInfMM) = ($NInf, $NInf);;
176 $PInfPP++;
177 $PInfMM--;
178 $NInfPP++;
179 $NInfMM--;
180 is($PInfPP, $PInf, "+Inf++ is +Inf");
181 is($PInfMM, $PInf, "+Inf-- is +Inf");
182 is($NInfPP, $NInf, "-Inf++ is -Inf");
183 is($NInfMM, $NInf, "-Inf-- is -Inf");
184
185 ok($PInf, "+Inf is true");
186 ok($NInf, "-Inf is true");
187
188 is(abs($PInf), $PInf, "abs(+Inf) is +Inf");
189 is(abs($NInf), $PInf, "abs(-Inf) is +Inf");
190
191 # One could argue of NaN as the result.
192 is(int($PInf), $PInf, "int(+Inf) is +Inf");
193 is(int($NInf), $NInf, "int(-Inf) is -Inf");
194
195 is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf");
196 # sqrt $NInf doesn't work because negative is caught
197
198 is(exp($PInf), $PInf, "exp(+Inf) is +Inf");
199 is(exp($NInf), 0, "exp(-Inf) is zero");
200
201 SKIP: {
202     if ($PInf == 0) {
203         skip "if +Inf == 0 cannot log(+Inf)", 1;
204     }
205     is(log($PInf), $PInf, "log(+Inf) is +Inf");
206 }
207 # log $NInf doesn't work because negative is caught
208
209 is(rand($PInf), $PInf, "rand(+Inf) is +Inf");
210 is(rand($NInf), $NInf, "rand(-Inf) is -Inf");
211
212 # XXX Bit operations?
213 # +Inf & 1 == +Inf?
214 # +Inf | 1 == +Inf?
215 # +Inf ^ 1 == +Inf?
216 # ~+Inf    == 0? or NaN?
217 # -Inf ... ???
218 # NaN & 1 == NaN?
219 # NaN | 1 == NaN?
220 # NaN ^ 1 == NaN?
221 # ~NaN    == NaN???
222 # Or just declare insanity and die?
223
224 SKIP: {
225     my $here = "$^O $Config{osvers}";
226     if ($here =~ /^hpux 10/) {
227         skip "$here: pow doesn't generate Inf", 1;
228     }
229     is(9**9**9, $PInf, "9**9**9 is Inf");
230 }
231
232 SKIP: {
233     my @FInf = qw(Info Infiniti Infinityz);
234     if ($Config{usequadmath}) {
235         skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
236     }
237     # Silence "isn't numeric in addition", that's kind of the point.
238     local $^W = 0;
239     for my $i (@FInf) {
240         cmp_ok("$i" + 0, '==', 0, "false infinity $i");
241     }
242 }
243
244 # === NaN ===
245
246 cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
247 ok($NaN eq $NaN, "NaN is NaN stringifically");
248
249 is("$NaN", "NaN", "$NaN value stringifies as NaN");
250
251 is("+NaN" + 0, "NaN", "+NaN is NaN");
252 is("-NaN" + 0, "NaN", "-NaN is NaN");
253
254 is($NaN + 0, $NaN, "NaN + zero is NaN");
255
256 is($NaN + 1, $NaN, "NaN + one is NaN");
257
258 is($NaN * 2, $NaN, "twice NaN is NaN");
259 is($NaN / 2, $NaN, "half of NaN is NaN");
260
261 is($NaN * $NaN, $NaN, "NaN * NaN is NaN");
262 is($NaN / $NaN, $NaN, "NaN / NaN is NaN");
263
264 for my $f (@printf_fmt) {
265     is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
266 }
267
268 ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
269 like($@, qr/Cannot printf/, "$NaN sprintf fails");
270 ok(!defined eval { $a = sprintf("%c", "NaN")},
271   "sprintf %c stringy NaN undef");
272 like($@, qr/Cannot printf/, "stringy $NaN sprintf fails");
273
274 ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
275 like($@, qr/Cannot chr/, "NaN chr() fails");
276 ok(!defined eval { $a = chr("NaN") }, "chr stringy NaN undef");
277 like($@, qr/Cannot chr/, "stringy NaN chr() fails");
278
279 for my $f (@packi_fmt) {
280     ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef");
281     like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
282          "NaN pack $f fails");
283     ok(!defined eval { $a = pack($f, "NaN") },
284        "pack $f stringy NaN undef");
285     like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
286          "stringy NaN pack $f fails");
287 }
288
289 for my $f (@packf_fmt) {
290     ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
291     eval { $b = unpack($f, $a) };
292     cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN");
293 }
294
295 for my $f (@packs_fmt) {
296     ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
297     is($a, pack($f, "NaN"), "pack $f NaN same as 'NaN'");
298 }
299
300 is eval { unpack "p", pack 'p', $NaN }, "NaN", "pack p +NaN";
301 is eval { unpack "P3", pack 'P', $NaN }, "NaN", "pack P +NaN";
302
303 for my $i (@NaN) {
304     cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
305     is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
306 }
307
308 ok(!($NaN <  0), "NaN is not lt zero");
309 ok(!($NaN == 0), "NaN is not == zero");
310 ok(!($NaN >  0), "NaN is not gt zero");
311
312 ok(!($NaN < $NaN), "NaN is not lt NaN");
313 ok(!($NaN > $NaN), "NaN is not gt NaN");
314
315 # is() okay with $NaN because it uses eq.
316 is($NaN * 0, $NaN, "NaN times zero is NaN");
317 is($NaN * 2, $NaN, "NaN times two is NaN");
318
319 my ($NaNPP, $NaNMM) = ($NaN, $NaN);
320 $NaNPP++;
321 $NaNMM--;
322 is($NaNPP, $NaN, "+NaN++ is NaN");
323 is($NaNMM, $NaN, "+NaN-- is NaN");
324
325 # You might find this surprising (isn't NaN kind of like of undef?)
326 # but this is how it is.
327 ok($NaN, "NaN is true");
328
329 is(abs($NaN), $NaN, "abs(NaN) is NaN");
330 is(int($NaN), $NaN, "int(NaN) is NaN");
331 is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN");
332 is(exp($NaN), $NaN, "exp(NaN) is NaN");
333
334 SKIP: {
335     if ($NaN == 0) {
336         skip "if +NaN == 0 cannot log(+NaN)", 1;
337     }
338     is(log($NaN), $NaN, "log(NaN) is NaN");
339 }
340
341 is(sin($NaN), $NaN, "sin(NaN) is NaN");
342 is(rand($NaN), $NaN, "rand(NaN) is NaN");
343
344 SKIP: {
345     my $here = "$^O $Config{osvers}";
346     if ($here =~ /^hpux 10/) {
347         skip "$here: pow doesn't generate Inf, so sin(Inf) won't happen", 1;
348     }
349     is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
350 }
351
352 SKIP: {
353     my @FNaN = qw(NaX XNAN Ind Inx);
354     # Silence "isn't numeric in addition", that's kind of the point.
355     local $^W = 0;
356     for my $i (@FNaN) {
357         cmp_ok("$i" + 0, '==', 0, "false nan $i");
358     }
359 }
360
361 # === Tests combining Inf and NaN ===
362
363 # is() okay with $NaN because it uses eq.
364 is($PInf * 0,     $NaN, "Inf times zero is NaN");
365 is($PInf * $NaN,  $NaN, "Inf times NaN is NaN");
366 is($PInf + $NaN,  $NaN, "Inf plus NaN is NaN");
367 is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
368 is($PInf / $PInf, $NaN, "Inf div inf is NaN");
369 is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
370
371 ok(!($NaN <  $PInf), "NaN is not lt +Inf");
372 ok(!($NaN == $PInf), "NaN is not eq +Inf");
373 ok(!($NaN >  $PInf), "NaN is not gt +Inf");
374
375 ok(!($NaN <  $NInf), "NaN is not lt -Inf");
376 ok(!($NaN == $NInf), "NaN is not eq -Inf");
377 ok(!($NaN >  $NInf), "NaN is not gt -Inf");
378
379 is(sin($PInf), $NaN, "sin(+Inf) is NaN");
380
381 # === Overflows and Underflows ===
382
383 # 1e9999 (and 1e-9999) are large (and small) enough for even
384 # IEEE quadruple precision (magnitude 10**4932, and 10**-4932).
385
386 cmp_ok(1e9999,     '==', $PInf, "overflow to +Inf (compile time)");
387 cmp_ok('1e9999',   '==', $PInf, "overflow to +Inf (runtime)");
388 cmp_ok(-1e9999,    '==', $NInf, "overflow to -Inf (compile time)");
389 cmp_ok('-1e9999',  '==', $NInf, "overflow to -Inf (runtime)");
390 cmp_ok(1e-9999,    '==', 0,     "underflow to 0 (compile time) from pos");
391 cmp_ok('1e-9999',  '==', 0,     "underflow to 0 (runtime) from pos");
392 cmp_ok(-1e-9999,   '==', 0,     "underflow to 0 (compile time) from neg");
393 cmp_ok('-1e-9999', '==', 0,     "underflow to 0 (runtime) from neg");
394
395 done_testing();