From 0c7df90239f4c313f42964755700c2a3c78ec63c Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Tue, 23 Sep 2014 13:41:08 -0400 Subject: [PATCH] Make pack-as-int/sprintf-%c-ing/chr-ring inf/nan fatal. In pack: No point in trying to return all-bit-off/all-bits-one because inf/-inf/nan really don't map sensibly into integers. In printf-%c/chr: while U+FFFD would be an option, better to die on such weird input. pack-as-fp still works, sprintf-numeric still works. Make t/op/infnan.t to be less fragile about the number of expected tests. --- pod/perldiag.pod | 37 +++---- pp.c | 9 +- pp_pack.c | 42 ++++---- sv.c | 9 +- t/op/infnan.t | 297 +++++++++++++++++++++++++++---------------------------- t/op/pack.t | 2 +- 6 files changed, 194 insertions(+), 202 deletions(-) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 80a197c..b29fff9 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -546,6 +546,15 @@ the warning. See L. (D deprecated) You called a function whose use is deprecated. See the function's name in L for details. +=item Cannot chr %f + +(F) You passed an invalid number (like an infinity or not-a-number) to C. + +=item Cannot compress %f + +(F) You tried converting an infinity or not-a-number to an +unsigned character, which makes no sense. + =item Cannot compress integer in pack (F) An argument to pack("w",...) was too large to compress. The BER @@ -575,6 +584,16 @@ be directly assigned to. (S io) You tried to apply an encoding that did not exist to a filehandle, either with open() or binmode(). +=item Cannot pack %f with '%c' + +(F) You tried converting an infinity or not-a-number to a character, +which makes no sense. + +=item Cannot printf %f with '%c' + +(F) You tried printing an infinity or not-a-number as a character (%c), +which makes no sense. Maybe you meant '%s', or just stringifying it? + =item Cannot set tied @DB::args (F) C tried to set C<@DB::args>, but found it tied. Tying C<@DB::args> @@ -1335,18 +1354,6 @@ Note that ASCII characters that don't map to control characters are discouraged, and will generate the warning (when enabled) L. -=item Character in 'C' format overflow in pack - -(W pack) You tried converting an infinity or not-a-number to an -unsigned character, which makes no sense. Perl behaved as if you -tried to pack 0xFF. - -=item Character in 'c' format overflow in pack - -(W pack) You tried converting an infinity or not-a-number to a -signed character, which makes no sense. Perl behaved as if you -tried to pack 0xFF. - =item Character in 'C' format wrapped in pack (W pack) You said @@ -2614,12 +2621,6 @@ a module that is a MRO plugin. See L and L. not valid character numbers, so it returns the Unicode replacement character (U+FFFD). -=item Invalid number (%f) in chr - -(W utf8) You passed an invalid number (like an infinity or -not-a-number) to C. Those are not valid character numbers, -so it return the Unicode replacement character (U+FFFD). - =item invalid option -D%c, use -D'' to see choices (S debugging) Perl was called with invalid debugger flags. Call perl diff --git a/pp.c b/pp.c index 2f0c905..d33914b 100644 --- a/pp.c +++ b/pp.c @@ -3371,13 +3371,8 @@ PP(pp_chr) SV *top = POPs; SvGETMAGIC(top); - if (SvNOK(top) && Perl_isinfnan(SvNV(top))) { - if (ckWARN(WARN_UTF8)) { - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "Invalid number (%"NVgf") in chr", SvNV(top)); - } - value = UNICODE_REPLACEMENT; - } + if (SvNOK(top) && Perl_isinfnan(SvNV(top))) + Perl_croak(aTHX_ "Cannot chr %"NVgf, SvNV(top)); else { if (!IN_BYTES /* under bytes, chr(-1) eq chr(0xff), etc. */ && ((SvIOKp(top) && !SvIsUV(top) && SvIV_nomg(top) < 0) diff --git a/pp_pack.c b/pp_pack.c index 17f7182..0e5b8dd 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -2114,6 +2114,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) bool needs_swap; #define NEXTFROM (lengthcode ? lengthcode : items-- > 0 ? *beglist++ : &PL_sv_no) +#define PEEKFROM (lengthcode ? lengthcode : items > 0 ? *beglist : &PL_sv_no) switch (howlen) { case e_star: @@ -2163,10 +2164,23 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) needs_swap = NEEDS_SWAP(datumtype); + fromstr = PEEKFROM; + if (SvNOK(fromstr)) { + const NV nv = SvNV(fromstr); + const char c = TYPE_NO_MODIFIERS(datumtype); + if (Perl_isinfnan(nv) && !strchr("fdFD", c)) { + if (c == 'w') + Perl_croak(aTHX_ "Cannot compress %"NVgf, nv); + else + Perl_croak(aTHX_ "Cannot pack %"NVgf" with '%c'", + nv, (int) c); + } + } + /* Code inside the switch must take care to properly update cat (CUR length and '\0' termination) if it updated *cur and doesn't simply leave using break */ - switch(TYPE_NO_ENDIANNESS(datumtype)) { + switch (TYPE_NO_ENDIANNESS(datumtype)) { default: Perl_croak(aTHX_ "Invalid type '%c' in pack", (int) TYPE_NO_MODIFIERS(datumtype)); @@ -2552,15 +2566,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) while (len-- > 0) { IV aiv; fromstr = NEXTFROM; - if (SvNOK(fromstr) && Perl_isinfnan(SvNV(fromstr))) { - /* 255 is a pretty arbitrary choice, but with - * inf/-inf/nan and 256 bytes there is not much room. */ - aiv = 255; - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Character in 'c' format overflow in pack"); - } - else - aiv = SvIV(fromstr); + aiv = SvIV(fromstr); if ((-128 > aiv || aiv > 127)) Perl_ck_warner(aTHX_ packWARN(WARN_PACK), "Character in 'c' format wrapped in pack"); @@ -2575,14 +2581,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) while (len-- > 0) { IV aiv; fromstr = NEXTFROM; - if (SvNOK(fromstr) && Perl_isinfnan(SvNV(fromstr))) { - /* See the 'c' case. */ - aiv = 255; - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Character in 'C' format overflow in pack"); - } - else - aiv = SvIV(fromstr); + aiv = SvIV(fromstr); if ((0 > aiv || aiv > 0xff)) Perl_ck_warner(aTHX_ packWARN(WARN_PACK), "Character in 'C' format wrapped in pack"); @@ -2900,17 +2899,12 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) char buf[1 + (int)((308 + 1) / 2)]; /* valid C */ #endif char *in = buf + sizeof(buf); - static const char S_cannot_compress[] = - "Cannot compress integer in pack"; - - if (Perl_isinfnan(anv)) - Perl_croak(aTHX_ S_cannot_compress); anv = Perl_floor(anv); do { const NV next = Perl_floor(anv / 128); if (in <= buf) /* this cannot happen ;-) */ - Perl_croak(aTHX_ S_cannot_compress); + Perl_croak(aTHX_ "Cannot compress integer in pack"); *--in = (unsigned char)(anv - (next * 128)) | 0x80; anv = next; } while (anv > 0); diff --git a/sv.c b/sv.c index f508c42..1a2f071 100644 --- a/sv.c +++ b/sv.c @@ -11484,7 +11484,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p } if (argsv && SvNOK(argsv)) { - /* XXX va_arg(*args) case? */ + /* XXX va_arg(*args) case? need peek, use va_copy? */ infnan = Perl_isinfnan(SvNV(argsv)); } @@ -11495,8 +11495,11 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p case 'c': if (vectorize) goto unknown; - uv = (args) ? va_arg(*args, int) : - infnan ? UNICODE_REPLACEMENT : SvIV(argsv); + if (infnan) + Perl_croak(aTHX_ "Cannot printf %"NVgf" with '%c'", + /* no va_arg() case */ + SvNV(argsv), (int)c); + uv = (args) ? va_arg(*args, int) : SvIV(argsv); if ((uv > 255 || (!UVCHR_IS_INVARIANT(uv) && SvUTF8(sv))) && !IN_BYTES) { diff --git a/t/op/infnan.t b/t/op/infnan.t index 17955e3..cc275d8 100644 --- a/t/op/infnan.t +++ b/t/op/infnan.t @@ -32,111 +32,116 @@ my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS", "NaN123", "NAN(123)", "nan%", "nanonano"); # RIP, Robin Williams. -my @num_fmt = qw(e f g a d u o b x p); +my @printf_fmt = qw(e f g a d u o i b x p); +my @packi_fmt = qw(a A Z b B h H c C s S l L i I n N v V j J w W p P u U); +my @packf_fmt = qw(f d F); -my $inf_tests = 13 + @num_fmt + 8 + 3 * @PInf + 3 * @NInf + 14 + 3; -my $nan_tests = 8 + @num_fmt + 4 + 2 * @NaN + 14; - -my $infnan_tests = 13; - -plan tests => $inf_tests + 1 + $nan_tests + 1 + $infnan_tests + 1; +if ($Config{ivsize} == 8) { + push @packi_fmt, qw(q Q); +} -print "# inf_tests = $inf_tests\n"; -print "# nan_tests = $nan_tests\n"; -print "# infnan_tests = $infnan_tests\n"; +if ($Config{uselongdouble}) { + push @packf_fmt, 'D'; +} -my $has_inf; -my $has_nan; +# === Inf tests === -SKIP: { - if ($PInf == 0 && $NInf == 0) { - skip "no infinity found", $inf_tests; - } +cmp_ok($PInf, '>', 0, "positive infinity"); +cmp_ok($NInf, '<', 0, "negative infinity"); - $has_inf = 1; +cmp_ok($PInf, '>', $NInf, "positive > negative"); +cmp_ok($NInf, '==', -$PInf, "negative == -positive"); +cmp_ok(-$NInf, '==', $PInf, "--negative == positive"); - cmp_ok($PInf, '>', 0, "positive infinity"); - cmp_ok($NInf, '<', 0, "negative infinity"); +is($PInf, "Inf", "$PInf value stringifies as Inf"); +is($NInf, "-Inf", "$NInf value stringifies as -Inf"); - cmp_ok($PInf, '>', $NInf, "positive > negative"); - cmp_ok($NInf, '==', -$PInf, "negative == -positive"); - cmp_ok(-$NInf, '==', $PInf, "--negative == positive"); +cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf"); +cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf"); - is($PInf, "Inf", "$PInf value stringifies as Inf"); - is($NInf, "-Inf", "$NInf value stringifies as -Inf"); +cmp_ok($PInf + 1, '==', $PInf, "Inf + one is Inf"); +cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf"); - cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf"); - cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf"); +is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf"); +is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf"); - cmp_ok($PInf + 1, '==', $PInf, "Inf + one is Inf"); - cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf"); +for my $f (@printf_fmt) { + is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf"); +} - is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf"); - is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf"); +ok(!defined eval { $a = sprintf("%c", $PInf)}, "sprintf %c +Inf undef"); +like($@, qr/Cannot printf/, "$PInf sprintf fails"); - for my $f (@num_fmt) { - is(sprintf("%$f", $PInf), "Inf", "$PInf sprintf %$f is Inf"); - } +ok(!defined eval { $a = chr($PInf) }, "chr(+Inf) undef"); +like($@, qr/Cannot chr/, "+Inf chr() fails"); - { - local $^W = 0; +ok(!defined eval { $a = sprintf("%c", $NInf)}, "sprintf %c -Inf undef"); +like($@, qr/Cannot printf/, "$NInf sprintf fails"); - is(sprintf("%c", $PInf), chr(0xFFFD), "$PInf sprintf %c is Inf"); - is(chr($PInf), chr(0xFFFD), "$PInf chr() is U+FFFD"); +ok(!defined eval { $a = chr($NInf) }, "chr(-Inf) undef"); +like($@, qr/Cannot chr/, "-Inf chr() fails"); - is(sprintf("%c", $NInf), chr(0xFFFD), "$NInf sprintf %c is Inf"); - is(chr($NInf), chr(0xFFFD), "$NInf chr() is U+FFFD"); +for my $f (@packi_fmt) { + ok(!defined eval { $a = pack($f, $PInf) }, "pack $f +Inf undef"); + like($@, $f eq 'w' ? qr/Cannot compress Inf/: qr/Cannot pack Inf/, + "+Inf pack $f fails"); + ok(!defined eval { $a = pack($f, $NInf) }, "pack $f -Inf undef"); + like($@, $f eq 'w' ? qr/Cannot compress -Inf/: qr/Cannot pack -Inf/, + "-Inf pack $f fails"); +} - is(pack('C', $PInf), chr(0xFF), "$PInf pack C is 0xFF byte"); - is(pack('c', $PInf), chr(0xFF), "$PInf pack c is 0xFF byte"); +for my $f (@packf_fmt) { + ok(defined eval { $a = pack($f, $PInf) }, "pack $f +Inf defined"); + eval { $b = unpack($f, $a) }; + cmp_ok($b, '==', $PInf, "pack $f +Inf equals $PInf"); - is(pack('C', $NInf), chr(0xFF), "$NInf pack C is 0xFF byte"); - is(pack('c', $NInf), chr(0xFF), "$NInf pack c is 0xFF byte"); - } + ok(defined eval { $a = pack($f, $NInf) }, "pack $f -Inf defined"); + eval { $b = unpack($f, $a) }; + cmp_ok($b, '==', $NInf, "pack $f -Inf equals $NInf"); +} - for my $i (@PInf) { +for my $i (@PInf) { cmp_ok($i + 0 , '==', $PInf, "$i is +Inf"); cmp_ok($i, '>', 0, "$i is positive"); is("@{[$i+0]}", "Inf", "$i value stringifies as Inf"); - } +} - for my $i (@NInf) { +for my $i (@NInf) { cmp_ok($i + 0, '==', $NInf, "$i is -Inf"); cmp_ok($i, '<', 0, "$i is negative"); is("@{[$i+0]}", "-Inf", "$i value stringifies as -Inf"); - } +} - is($PInf + $PInf, $PInf, "+inf plus +inf is +inf"); - is($NInf + $NInf, $NInf, "-inf plus -inf is -inf"); +is($PInf + $PInf, $PInf, "+Inf plus +Inf is +Inf"); +is($NInf + $NInf, $NInf, "-Inf plus -Inf is -Inf"); - is(1/$PInf, 0, "one per +Inf is zero"); - is(1/$NInf, 0, "one per -Inf is zero"); +is(1/$PInf, 0, "one per +Inf is zero"); +is(1/$NInf, 0, "one per -Inf is zero"); - my ($PInfPP, $PInfMM) = ($PInf, $PInf); - my ($NInfPP, $NInfMM) = ($NInf, $NInf);; - $PInfPP++; - $PInfMM--; - $NInfPP++; - $NInfMM--; - is($PInfPP, $PInf, "+inf++ is +inf"); - is($PInfMM, $PInf, "+inf-- is +inf"); - is($NInfPP, $NInf, "-inf++ is -inf"); - is($NInfMM, $NInf, "-inf-- is -inf"); +my ($PInfPP, $PInfMM) = ($PInf, $PInf); +my ($NInfPP, $NInfMM) = ($NInf, $NInf);; +$PInfPP++; +$PInfMM--; +$NInfPP++; +$NInfMM--; +is($PInfPP, $PInf, "+Inf++ is +Inf"); +is($PInfMM, $PInf, "+Inf-- is +Inf"); +is($NInfPP, $NInf, "-Inf++ is -Inf"); +is($NInfMM, $NInf, "-Inf-- is -Inf"); - ok($PInf, "+inf is true"); - ok($NInf, "-inf is true"); +ok($PInf, "+Inf is true"); +ok($NInf, "-Inf is true"); - is(sqrt($PInf), $PInf, "sqrt(+inf) is +inf"); - is(exp($PInf), $PInf, "exp(+inf) is +inf"); - is(exp($NInf), 0, "exp(-inf) is zero"); +is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf"); +is(exp($PInf), $PInf, "exp(+Inf) is +Inf"); +is(exp($NInf), 0, "exp(-Inf) is zero"); - SKIP: { - my $here = "$^O $Config{osvers}"; - if ($here =~ /^hpux 10/) { - skip "$here: pow doesn't generate Inf", 1; - } - is(9**9**9, $PInf, "9**9**9 is Inf"); - } +SKIP: { + my $here = "$^O $Config{osvers}"; + if ($here =~ /^hpux 10/) { + skip "$here: pow doesn't generate Inf", 1; + } + is(9**9**9, $PInf, "9**9**9 is Inf"); } SKIP: { @@ -151,105 +156,99 @@ SKIP: { } } -is(curr_test() - 1, $inf_tests, "expected number of inf tests"); +# === NaN === -SKIP: { - if ($NaN == 0) { - skip "no nan found", $nan_tests; - } - - $has_nan = 1; +cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)"); +ok($NaN eq $NaN, "NaN is NaN stringifically"); - cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)"); - ok($NaN eq $NaN, "NaN is NaN stringifically"); +is("$NaN", "NaN", "$NaN value stringifies as NaN"); - is("$NaN", "NaN", "$NaN value stringifies as NaN"); +is("+NaN" + 0, "NaN", "+NaN is NaN"); +is("-NaN" + 0, "NaN", "-NaN is NaN"); - is("+NaN" + 0, "NaN", "+NaN is NaN"); - is("-NaN" + 0, "NaN", "-NaN is NaN"); +is($NaN * 2, $NaN, "twice NaN is NaN"); +is($NaN / 2, $NaN, "half of NaN is NaN"); - is($NaN * 2, $NaN, "twice NaN is NaN"); - is($NaN / 2, $NaN, "half of NaN is NaN"); +is($NaN + 1, $NaN, "NaN + one is NaN"); - is($NaN + 1, $NaN, "NaN + one is NaN"); +for my $f (@printf_fmt) { + is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN"); +} - for my $f (@num_fmt) { - is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN"); - } +ok(!defined eval { $a = sprintf("%c", $NaN)}, "sprintf %c NaN undef"); +like($@, qr/Cannot printf/, "$NaN sprintf fails"); - { - local $^W = 0; +ok(!defined eval { $a = chr($NaN) }, "chr NaN undef"); +like($@, qr/Cannot chr/, "NaN chr() fails"); - is(sprintf("%c", $NaN), chr(0xFFFD), "$NaN sprintf %c is Inf"); - is(chr($NaN), chr(0xFFFD), "$NaN chr() is U+FFFD"); +for my $f (@packi_fmt) { + ok(!defined eval { $a = pack($f, $NaN) }, "pack $f NaN undef"); + like($@, $f eq 'w' ? qr/Cannot compress NaN/: qr/Cannot pack NaN/, + "NaN pack $f fails"); +} - is(pack('C', $NaN), chr(0xFF), "$NaN pack C is 0xFF byte"); - is(pack('c', $NaN), chr(0xFF), "$NaN pack c is 0xFF"); - } +for my $f (@packf_fmt) { + ok(defined eval { $a = pack($f, $NaN) }, "pack $f NaN defined"); + eval { $b = unpack($f, $a) }; + cmp_ok($b, '!=', $b, "pack $f NaN not-equals $NaN"); +} - for my $i (@NaN) { +for my $i (@NaN) { cmp_ok($i + 0, '!=', $i + 0, "$i is NaN numerically (by not being NaN)"); is("@{[$i+0]}", "NaN", "$i value stringifies as NaN"); - } +} - ok(!($NaN < 0), "NaN is not lt zero"); - ok(!($NaN == 0), "NaN is not == zero"); - ok(!($NaN > 0), "NaN is not gt zero"); +ok(!($NaN < 0), "NaN is not lt zero"); +ok(!($NaN == 0), "NaN is not == zero"); +ok(!($NaN > 0), "NaN is not gt zero"); - ok(!($NaN < $NaN), "NaN is not lt NaN"); - ok(!($NaN > $NaN), "NaN is not gt NaN"); +ok(!($NaN < $NaN), "NaN is not lt NaN"); +ok(!($NaN > $NaN), "NaN is not gt NaN"); - # is() okay with $NaN because it uses eq. - is($NaN * 0, $NaN, "NaN times zero is NaN"); - is($NaN * 2, $NaN, "NaN times two is NaN"); +# is() okay with $NaN because it uses eq. +is($NaN * 0, $NaN, "NaN times zero is NaN"); +is($NaN * 2, $NaN, "NaN times two is NaN"); - my ($NaNPP, $NaNMM) = ($NaN, $NaN); - $NaNPP++; - $NaNMM--; - is($NaNPP, $NaN, "+inf++ is +inf"); - is($NaNMM, $NaN, "+inf-- is +inf"); +my ($NaNPP, $NaNMM) = ($NaN, $NaN); +$NaNPP++; +$NaNMM--; +is($NaNPP, $NaN, "+Inf++ is +Inf"); +is($NaNMM, $NaN, "+Inf-- is +Inf"); - ok($NaN, "NaN is true"); +# You might find this surprising (isn't NaN kind of like of undef?) +# but this is how it is. +ok($NaN, "NaN is true"); - is(sqrt($NaN), $NaN, "sqrt(nan) is nan"); - is(exp($NaN), $NaN, "exp(nan) is nan"); - is(sin($NaN), $NaN, "sin(nan) is nan"); +is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN"); +is(exp($NaN), $NaN, "exp(NaN) is NaN"); +is(sin($NaN), $NaN, "sin(NaN) is NaN"); - SKIP: { - my $here = "$^O $Config{osvers}"; - if ($here =~ /^hpux 10/) { - skip "$here: pow doesn't generate Inf, so sin(Inf) won't happen", 1; - } - is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN"); - } +SKIP: { + my $here = "$^O $Config{osvers}"; + if ($here =~ /^hpux 10/) { + skip "$here: pow doesn't generate Inf, so sin(Inf) won't happen", 1; + } + is(sin(9**9**9), $NaN, "sin(9**9**9) is NaN"); } -is(curr_test() - 1, $inf_tests + 1 + $nan_tests, - "expected number of nan tests"); +# === Tests combining Inf and NaN === -SKIP: { - unless ($has_inf && $has_nan) { - skip "no both Inf and Nan", $infnan_tests; - } +# 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"); - # 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 < $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"); - 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"); -} +is(sin($PInf), $NaN, "sin(+Inf) is NaN"); -is(curr_test() - 1, $inf_tests + 1 + $nan_tests + 1 + $infnan_tests, - "expected number of nan tests"); +done_testing(); diff --git a/t/op/pack.t b/t/op/pack.t index 9340f32..2e3c0f5 100644 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -315,7 +315,7 @@ sub list_eq ($$) { if ($^O eq 'vos'); eval { $x = pack 'w', $inf }; - like ($@, qr/^Cannot compress integer/, "Cannot compress integer"); + like ($@, qr/^Cannot compress Inf/, "Cannot compress infinity"); } SKIP: { -- 1.8.3.1