From 75a57a380101eae68ead055d5951db492491701d Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Sun, 25 Jan 2015 18:36:18 -0500 Subject: infnan: numify warning testing. --- t/op/infnan.t | 82 +++++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 66 insertions(+), 16 deletions(-) (limited to 't/op/infnan.t') diff --git a/t/op/infnan.t b/t/op/infnan.t index 6e59121640..ae84111c0c 100644 --- a/t/op/infnan.t +++ b/t/op/infnan.t @@ -404,22 +404,6 @@ SKIP: { is("a" x $NaN, "", "x NaN"); } -{ - my $w; - local $SIG{__WARN__} = sub { $w = shift }; - local $^W = 1; - my $a; - eval '$a = "nancy" + 1'; - is($a, "$NaN", "nancy plus one is $NaN"); - like($w, qr/^Argument "nancy" isn't numeric/, "nancy numify (compile time)"); - - my $n = "nanana"; - my $b; - eval '$b = $n + 1'; - is($b, "$NaN", "$n plus one is $NaN"); - like($w, qr/^Argument "$n" isn't numeric/, "$n numify (runtime)"); -} - # === Tests combining Inf and NaN === # is() okay with $NaN because it uses eq. @@ -462,4 +446,70 @@ 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 ], + [ "infxy", 1, $PInf ], + [ "inf34", 1, $PInf ], + [ "1.#INF", 0, $PInf ], + [ "1.#INFx", 1, $PInf ], + [ "1.#INF00", 0, $PInf ], + [ "1.#INFxy", 1, $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 ], + ]; + + 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(); -- cgit v1.2.1