+
+# === Tests combining Inf and NaN ===
+
+# is() okay with $NaN because it uses eq.
+is($PInf * 0, $NaN, "Inf times zero is NaN");
+is($PInf * $NaN, $NaN, "Inf times NaN is NaN");
+is($PInf + $NaN, $NaN, "Inf plus NaN is NaN");
+is($PInf - $PInf, $NaN, "Inf minus inf is NaN");
+is($PInf / $PInf, $NaN, "Inf div inf is NaN");
+is($PInf % $PInf, $NaN, "Inf mod inf is NaN");
+
+ok(!($NaN < $PInf), "NaN is not lt +Inf");
+ok(!($NaN == $PInf), "NaN is not eq +Inf");
+ok(!($NaN > $PInf), "NaN is not gt +Inf");
+
+ok(!($NaN < $NInf), "NaN is not lt -Inf");
+ok(!($NaN == $NInf), "NaN is not eq -Inf");
+ok(!($NaN > $NInf), "NaN is not gt -Inf");
+
+is(sin($PInf), $NaN, "sin(+Inf) is NaN");
+
+{
+ eval 'for my $x (0..$NaN) { last }';
+ like($@, qr/Range iterator outside integer range/, "0..NaN fails");
+
+ eval 'for my $x ($NaN..0) { last }';
+ like($@, qr/Range iterator outside integer range/, "NaN..0 fails");
+}
+
+# === Overflows and Underflows ===
+
+# 1e9999 (and 1e-9999) are large (and small) enough for even
+# IEEE quadruple precision (magnitude 10**4932, and 10**-4932).
+
+cmp_ok(1e9999, '==', $PInf, "overflow to +Inf (compile time)");
+cmp_ok('1e9999', '==', $PInf, "overflow to +Inf (runtime)");
+cmp_ok(-1e9999, '==', $NInf, "overflow to -Inf (compile time)");
+cmp_ok('-1e9999', '==', $NInf, "overflow to -Inf (runtime)");
+cmp_ok(1e-9999, '==', 0, "underflow to 0 (compile time) from pos");
+cmp_ok('1e-9999', '==', 0, "underflow to 0 (runtime) from pos");
+cmp_ok(-1e-9999, '==', 0, "underflow to 0 (compile time) from neg");
+cmp_ok('-1e-9999', '==', 0, "underflow to 0 (runtime) from neg");
+
+# === Warnings triggered when and only when appropriate ===
+{
+ my $w;
+ local $SIG{__WARN__} = sub { $w = shift };
+ local $^W = 1;
+
+ my $T =
+ [
+ [ "inf", 0, $PInf ],
+ [ "infinity", 0, $PInf ],
+ [ "infxy", 1, $PInf ],
+ [ "inf34", 1, $PInf ],
+ [ "1.#INF", 0, $PInf ],
+ [ "1.#INFx", 1, $PInf ],
+ [ "1.#INF00", 0, $PInf ],
+ [ "1.#INFxy", 1, $PInf ],
+ [ " inf", 0, $PInf ],
+ [ "inf ", 0, $PInf ],
+ [ " inf ", 0, $PInf ],
+
+ [ "nan", 0, $NaN ],
+ [ "nanxy", 1, $NaN ],
+ [ "nan34", 1, $NaN ],
+ [ "nanq", 0, $NaN ],
+ [ "nans", 0, $NaN ],
+ [ "nanx", 1, $NaN ],
+ [ "nanqy", 1, $NaN ],
+ [ "nan(123)", 0, $NaN ],
+ [ "nan(0x123)", 0, $NaN ],
+ [ "nan(123xy)", 1, $NaN ],
+ [ "nan(0x123xy)", 1, $NaN ],
+ [ "nanq(123)", 0, $NaN ],
+ [ "nan(123", 1, $NaN ],
+ [ "nan(", 1, $NaN ],
+ [ "1.#NANQ", 0, $NaN ],
+ [ "1.#QNAN", 0, $NaN ],
+ [ "1.#NANQx", 1, $NaN ],
+ [ "1.#QNANx", 1, $NaN ],
+ [ "1.#IND", 0, $NaN ],
+ [ "1.#IND00", 0, $NaN ],
+ [ "1.#INDxy", 1, $NaN ],
+ [ " nan", 0, $NaN ],
+ [ "nan ", 0, $NaN ],
+ [ " nan ", 0, $NaN ],
+ ];
+
+ for my $t (@$T) {
+ print "# '$t->[0]' compile time\n";
+ my $a;
+ $w = '';
+ eval '$a = "'.$t->[0].'" + 1';
+ is("$a", "$t->[2]", "$t->[0] plus one is $t->[2]");
+ if ($t->[1]) {
+ like($w, qr/^Argument \Q"$t->[0]"\E isn't numeric/,
+ "$t->[2] numify warn");
+ } else {
+ is($w, "", "no warning expected");
+ }
+ print "# '$t->[0]' runtime\n";
+ my $n = $t->[0];
+ my $b;
+ $w = '';
+ eval '$b = $n + 1';
+ is("$b", "$t->[2]", "$n plus one is $t->[2]");
+ if ($t->[1]) {
+ like($w, qr/^Argument \Q"$n"\E isn't numeric/,
+ "$n numify warn");
+ } else {
+ is($w, "", "no warning expected");
+ }
+ }
+}
+
+done_testing();