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";
22 my $NInf = "-Inf" + 0;
25 local $^W = 0; # warning-ness tested later.
29 my @PInf = ("Inf", "inf", "INF", "+Inf",
31 "1.#INF", "1#INF", "1.#INF00");
32 my @NInf = map { "-$_" } grep { ! /^\+/ } @PInf;
34 my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS",
35 "1.#QNAN", "+1#SNAN", "-1.#NAN", "1#IND", "1.#IND00",
38 my @printf_fmt = qw(e f g a d u o i b x p);
39 my @packi_fmt = qw(c C s S l L i I n N v V j J w W U);
40 my @packf_fmt = qw(f d F);
41 my @packs_fmt = qw(a4 A4 Z5 b20 B20 h10 H10 u);
43 if ($Config{ivsize} == 8) {
44 push @packi_fmt, qw(q Q);
47 if ($Config{uselongdouble} && $Config{nvsize} > $Config{doublesize}) {
53 cmp_ok($PInf, '>', 0, "positive infinity");
54 cmp_ok($NInf, '<', 0, "negative infinity");
56 cmp_ok($PInf, '>', $NInf, "positive > negative");
57 cmp_ok($NInf, '==', -$PInf, "negative == -positive");
58 cmp_ok(-$NInf, '==', $PInf, "--negative == positive");
60 is($PInf, "Inf", "$PInf value stringifies as Inf");
61 is($NInf, "-Inf", "$NInf value stringifies as -Inf");
63 cmp_ok($PInf + 0, '==', $PInf, "+Inf + zero is +Inf");
64 cmp_ok($NInf + 0, '==', $NInf, "-Inf + zero is -Inf");
66 cmp_ok($PInf + 1, '==', $PInf, "+Inf + one is +Inf");
67 cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf");
69 cmp_ok($PInf + $PInf, '==', $PInf, "+Inf + Inf is +Inf");
70 cmp_ok($NInf + $NInf, '==', $NInf, "-Inf - Inf is -Inf");
72 cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf");
73 cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf");
75 cmp_ok($PInf * $PInf, '==', $PInf, "+Inf * +Inf is +Inf");
76 cmp_ok($PInf * $NInf, '==', $NInf, "+Inf * -Inf is -Inf");
77 cmp_ok($NInf * $PInf, '==', $NInf, "-Inf * +Inf is -Inf");
78 cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf");
80 is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf");
81 is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf");
83 for my $f (@printf_fmt) {
84 is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf");
87 is(sprintf("%+g", $PInf), "+Inf", "$PInf sprintf %+g");
88 is(sprintf("%+g", $NInf), "-Inf", "$PInf sprintf %+g");
90 is(sprintf("%4g", $PInf), " Inf", "$PInf sprintf %4g");
91 is(sprintf("%-4g", $PInf), "Inf ", "$PInf sprintf %-4g");
93 is(sprintf("%+-5g", $PInf), "+Inf ", "$PInf sprintf %+-5g");
94 is(sprintf("%-+5g", $PInf), "+Inf ", "$PInf sprintf %-+5g");
96 is(sprintf("%-+5g", $NInf), "-Inf ", "$NInf sprintf %-+5g");
97 is(sprintf("%+-5g", $NInf), "-Inf ", "$NInf sprintf %+-5g");
99 ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef");
100 like($@, qr/Cannot printf/, "$PInf sprintf fails");
101 ok(!defined eval { $a = sprintf("%c", "Inf")},
102 "stringy sprintf %c +Inf undef");
103 like($@, qr/Cannot printf/, "stringy $PInf sprintf %c fails");
105 ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef");
106 like($@, qr/Cannot chr/, "+Inf chr() fails");
107 ok(!defined eval { $a = chr("Inf") }, "chr(stringy +Inf) undef");
108 like($@, qr/Cannot chr/, "stringy +Inf chr() fails");
110 ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef");
111 like($@, qr/Cannot printf/, "$NInf sprintf fails");
112 ok(!defined eval { $a = sprintf("%c", "-Inf")},
113 "sprintf %c stringy -Inf undef");
114 like($@, qr/Cannot printf/, "stringy $NInf sprintf %c fails");
116 ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef");
117 like($@, qr/Cannot chr/, "-Inf chr() fails");
118 ok(!defined eval { $a = chr("-Inf") }, "chr(stringy -Inf) undef");
119 like($@, qr/Cannot chr/, "stringy -Inf chr() fails");
121 for my $f (@packi_fmt) {
123 ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef");
124 like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
125 "+Inf pack $f fails");
127 ok(!defined eval { $a = pack($f, "Inf") },
128 "pack $f stringy +Inf undef");
129 like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/,
130 "stringy +Inf pack $f fails");
132 ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef");
133 like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
134 "-Inf pack $f fails");
136 ok(!defined eval { $a = pack($f, "-Inf") },
137 "pack $f stringy -Inf undef");
138 like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/,
139 "stringy -Inf pack $f fails");
142 for my $f (@packf_fmt) {
145 ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
146 eval { $b = unpack($f, $a) };
147 cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf");
151 ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
152 eval { $b = unpack($f, $a) };
153 cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf");
156 for my $f (@packs_fmt) {
158 ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined");
159 is($a, pack($f, "Inf"), "pack $f +Inf same as 'Inf'");
162 ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined");
163 is($a, pack($f, "-Inf"), "pack $f -Inf same as 'Inf'");
166 is eval { unpack "p", pack 'p', $PInf }, "Inf", "pack p +Inf";
167 is eval { unpack "P3", pack 'P', $PInf }, "Inf", "pack P +Inf";
168 is eval { unpack "p", pack 'p', $NInf }, "-Inf", "pack p -Inf";
169 is eval { unpack "P4", pack 'P', $NInf }, "-Inf", "pack P -Inf";
172 cmp_ok($i + 0 , '==', $PInf, "$i is +Inf");
173 cmp_ok($i, '>', 0, "$i is positive");
174 is("@{[$i+0]}", "Inf", "$i value stringifies as Inf");
178 cmp_ok($i + 0, '==', $NInf, "$i is -Inf");
179 cmp_ok($i, '<', 0, "$i is negative");
180 is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf");
183 is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf");
184 is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf");
186 is(1/$PInf, 0, "one per +Inf is zero");
187 is(1/$NInf, 0, "one per -Inf is zero");
189 my ($PInfPP, $PInfMM) = ($PInf, $PInf);
190 my ($NInfPP, $NInfMM) = ($NInf, $NInf);;
195 is($PInfPP, $PInf, "+Inf++ is +Inf");
196 is($PInfMM, $PInf, "+Inf-- is +Inf");
197 is($NInfPP, $NInf, "-Inf++ is -Inf");
198 is($NInfMM, $NInf, "-Inf-- is -Inf");
200 ok($PInf, "+Inf is true");
201 ok($NInf, "-Inf is true");
203 is(abs($PInf), $PInf, "abs(+Inf) is +Inf");
204 is(abs($NInf), $PInf, "abs(-Inf) is +Inf");
206 # One could argue of NaN as the result.
207 is(int($PInf), $PInf, "int(+Inf) is +Inf");
208 is(int($NInf), $NInf, "int(-Inf) is -Inf");
210 is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf");
211 # sqrt $NInf doesn't work because negative is caught
213 is(exp($PInf), $PInf, "exp(+Inf) is +Inf");
214 is(exp($NInf), 0, "exp(-Inf) is zero");
218 skip "if +Inf == 0 cannot log(+Inf)", 1;
220 is(log($PInf), $PInf, "log(+Inf) is +Inf");
222 # log $NInf doesn't work because negative is caught
224 is(rand($PInf), $PInf, "rand(+Inf) is +Inf");
225 is(rand($NInf), $NInf, "rand(-Inf) is -Inf");
227 # XXX Bit operations?
231 # ~+Inf == 0? or NaN?
237 # Or just declare insanity and die?
241 my $here = "$^O $Config{osvers}";
242 $::TODO = "$here: pow (9**9**9) doesn't give Inf"
243 if $here =~ /^(?:hpux 10|os390)/;
244 is(9**9**9, $PInf, "9**9**9 is Inf");
248 my @FInf = qw(Infinite Info Inf123 Infiniti Infinityz);
249 if ($Config{usequadmath}) {
250 skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
253 # Silence "isn't numeric in addition", that's kind of the point.
255 cmp_ok("$i" + 0, '==', $PInf, "false infinity $i");
260 # Silence "Non-finite repeat count", that is tested elsewhere.
262 is("a" x $PInf, "", "x +Inf");
263 is("a" x $NInf, "", "x -Inf");
267 eval 'for my $x (0..$PInf) { last }';
268 like($@, qr/Range iterator outside integer range/, "0..+Inf fails");
270 eval 'for my $x ($NInf..0) { last }';
271 like($@, qr/Range iterator outside integer range/, "-Inf..0 fails");
276 cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)");
277 ok($NaN eq $NaN, "NaN is NaN stringifically");
279 is("$NaN", "NaN", "$NaN value stringifies as NaN");
282 local $^W = 0; # warning-ness tested later.
283 is("+NaN" + 0, "NaN", "+NaN is NaN");
284 is("-NaN" + 0, "NaN", "-NaN is NaN");
287 is($NaN + 0, $NaN, "NaN + zero is NaN");
289 is($NaN + 1, $NaN, "NaN + one is NaN");
291 is($NaN * 2, $NaN, "twice NaN is NaN");
292 is($NaN / 2, $NaN, "half of NaN is NaN");
294 is($NaN * $NaN, $NaN, "NaN * NaN is NaN");
295 is($NaN / $NaN, $NaN, "NaN / NaN is NaN");
297 for my $f (@printf_fmt) {
298 is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN");
301 is(sprintf("%+g", $NaN), "NaN", "$NaN sprintf %+g");
303 is(sprintf("%4g", $NaN), " NaN", "$NaN sprintf %4g");
304 is(sprintf("%-4g", $NaN), "NaN ", "$NaN sprintf %-4g");
306 is(sprintf("%+-5g", $NaN), "NaN ", "$NaN sprintf %+-5g");
307 is(sprintf("%-+5g", $NaN), "NaN ", "$NaN sprintf %-+5g");
309 ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef");
310 like($@, qr/Cannot printf/, "$NaN sprintf fails");
311 ok(!defined eval { $a = sprintf("%c", "NaN")},
312 "sprintf %c stringy NaN undef");
313 like($@, qr/Cannot printf/, "stringy $NaN sprintf %c fails");
315 ok(!defined eval { $a = chr($NaN) }, "chr NaN undef");
316 like($@, qr/Cannot chr/, "NaN chr() fails");
317 ok(!defined eval { $a = chr("NaN") }, "chr stringy NaN undef");
318 like($@, qr/Cannot chr/, "stringy NaN chr() fails");
320 for my $f (@packi_fmt) {
321 ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef");
322 like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
323 "NaN pack $f fails");
324 ok(!defined eval { $a = pack($f, "NaN") },
325 "pack $f stringy NaN undef");
326 like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/,
327 "stringy NaN pack $f fails");
330 for my $f (@packf_fmt) {
331 ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
332 eval { $b = unpack($f, $a) };
333 cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN");
336 for my $f (@packs_fmt) {
337 ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined");
338 is($a, pack($f, "NaN"), "pack $f NaN same as 'NaN'");
341 is eval { unpack "p", pack 'p', $NaN }, "NaN", "pack p +NaN";
342 is eval { unpack "P3", pack 'P', $NaN }, "NaN", "pack P +NaN";
345 cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)");
346 is("@{[$i+0]}", "NaN", "$i value stringifies as NaN");
349 ok(!($NaN < 0), "NaN is not lt zero");
350 ok(!($NaN == 0), "NaN is not == zero");
351 ok(!($NaN > 0), "NaN is not gt zero");
353 ok(!($NaN < $NaN), "NaN is not lt NaN");
354 ok(!($NaN > $NaN), "NaN is not gt NaN");
356 # is() okay with $NaN because it uses eq.
357 is($NaN * 0, $NaN, "NaN times zero is NaN");
358 is($NaN * 2, $NaN, "NaN times two is NaN");
360 my ($NaNPP, $NaNMM) = ($NaN, $NaN);
363 is($NaNPP, $NaN, "+NaN++ is NaN");
364 is($NaNMM, $NaN, "+NaN-- is NaN");
366 # You might find this surprising (isn't NaN kind of like of undef?)
367 # but this is how it is.
368 ok($NaN, "NaN is true");
370 is(abs($NaN), $NaN, "abs(NaN) is NaN");
371 is(int($NaN), $NaN, "int(NaN) is NaN");
372 is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN");
373 is(exp($NaN), $NaN, "exp(NaN) is NaN");
377 skip "if +NaN == 0 cannot log(+NaN)", 1;
379 is(log($NaN), $NaN, "log(NaN) is NaN");
382 is(sin($NaN), $NaN, "sin(NaN) is NaN");
383 is(rand($NaN), $NaN, "rand(NaN) is NaN");
387 my $here = "$^O $Config{osvers}";
388 $::TODO = "$here: pow (9**9**9) doesn't give Inf"
389 if $here =~ /^(?:hpux 10|os390)/;
390 is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN");
394 my @FNaN = qw(NaX XNAN Ind Inx);
395 # Silence "isn't numeric in addition", that's kind of the point.
398 cmp_ok("$i" + 0, '==', 0, "false nan $i");
403 # Silence "Non-finite repeat count", that is tested elsewhere.
405 is("a" x $NaN, "", "x NaN");
408 # === Tests combining Inf and NaN ===
410 # is() okay with $NaN because it uses eq.
411 is($PInf * 0, $NaN, "Inf times zero is NaN");
412 is($PInf * $NaN, $NaN, "Inf times NaN is NaN");
413 is($PInf + $NaN, $NaN, "Inf plus NaN is NaN");
414 is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
415 is($PInf / $PInf, $NaN, "Inf div inf is NaN");
416 is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
418 ok(!($NaN < $PInf), "NaN is not lt +Inf");
419 ok(!($NaN == $PInf), "NaN is not eq +Inf");
420 ok(!($NaN > $PInf), "NaN is not gt +Inf");
422 ok(!($NaN < $NInf), "NaN is not lt -Inf");
423 ok(!($NaN == $NInf), "NaN is not eq -Inf");
424 ok(!($NaN > $NInf), "NaN is not gt -Inf");
426 is(sin($PInf), $NaN, "sin(+Inf) is NaN");
429 eval 'for my $x (0..$NaN) { last }';
430 like($@, qr/Range iterator outside integer range/, "0..NaN fails");
432 eval 'for my $x ($NaN..0) { last }';
433 like($@, qr/Range iterator outside integer range/, "NaN..0 fails");
436 # === Overflows and Underflows ===
438 # 1e9999 (and 1e-9999) are large (and small) enough for even
439 # IEEE quadruple precision (magnitude 10**4932, and 10**-4932).
441 cmp_ok(1e9999, '==', $PInf, "overflow to +Inf (compile time)");
442 cmp_ok('1e9999', '==', $PInf, "overflow to +Inf (runtime)");
443 cmp_ok(-1e9999, '==', $NInf, "overflow to -Inf (compile time)");
444 cmp_ok('-1e9999', '==', $NInf, "overflow to -Inf (runtime)");
445 cmp_ok(1e-9999, '==', 0, "underflow to 0 (compile time) from pos");
446 cmp_ok('1e-9999', '==', 0, "underflow to 0 (runtime) from pos");
447 cmp_ok(-1e-9999, '==', 0, "underflow to 0 (compile time) from neg");
448 cmp_ok('-1e-9999', '==', 0, "underflow to 0 (runtime) from neg");
450 # === Warnings triggered when and only when appropriate ===
453 local $SIG{__WARN__} = sub { $w = shift };
459 [ "infinity", 0, $PInf ],
460 [ "infxy", 1, $PInf ],
461 [ "inf34", 1, $PInf ],
462 [ "1.#INF", 0, $PInf ],
463 [ "1.#INFx", 1, $PInf ],
464 [ "1.#INF00", 0, $PInf ],
465 [ "1.#INFxy", 1, $PInf ],
466 [ " inf", 0, $PInf ],
467 [ "inf ", 0, $PInf ],
468 [ " inf ", 0, $PInf ],
471 [ "nanxy", 1, $NaN ],
472 [ "nan34", 1, $NaN ],
476 [ "nanqy", 1, $NaN ],
477 [ "nan(123)", 0, $NaN ],
478 [ "nan(0x123)", 0, $NaN ],
479 [ "nan(123xy)", 1, $NaN ],
480 [ "nan(0x123xy)", 1, $NaN ],
481 [ "nanq(123)", 0, $NaN ],
482 [ "nan(123", 1, $NaN ],
484 [ "1.#NANQ", 0, $NaN ],
485 [ "1.#QNAN", 0, $NaN ],
486 [ "1.#NANQx", 1, $NaN ],
487 [ "1.#QNANx", 1, $NaN ],
488 [ "1.#IND", 0, $NaN ],
489 [ "1.#IND00", 0, $NaN ],
490 [ "1.#INDxy", 1, $NaN ],
493 [ " nan ", 0, $NaN ],
497 print "# '$t->[0]' compile time\n";
500 eval '$a = "'.$t->[0].'" + 1';
501 is("$a", "$t->[2]", "$t->[0] plus one is $t->[2]");
503 like($w, qr/^Argument \Q"$t->[0]"\E isn't numeric/,
504 "$t->[2] numify warn");
506 is($w, "", "no warning expected");
508 print "# '$t->[0]' runtime\n";
513 is("$b", "$t->[2]", "$n plus one is $t->[2]");
515 like($w, qr/^Argument \Q"$n"\E isn't numeric/,
518 is($w, "", "no warning expected");