+# === 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");
+ }
+ }
+}
+