In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a13f4dff39a8e5b2dfd82fe8fb21125753c7022b?hp=3613e672611050280ed9ed15546538e2b16b9a45>
- Log ----------------------------------------------------------------- commit a13f4dff39a8e5b2dfd82fe8fb21125753c7022b Author: Jarkko Hietaniemi <[email protected]> Date: Wed Sep 24 07:29:09 2014 -0400 If we already know it's infnan, no need to Atof again. M sv.c commit 5bf8b78e07edcdb636cf0f1a8c1e9e97f2ce2f53 Author: Jarkko Hietaniemi <[email protected]> Date: Tue Sep 23 21:04:21 2014 -0400 infnan: more math tests, and make int(infnan) return infnan. Though one could argue int(inf) returning nan, too. Depends on whether you glare at the "inf" or "int". M pp.c M t/op/infnan.t ----------------------------------------------------------------------- Summary of changes: pp.c | 4 +++- sv.c | 38 ++++++++++++++++++++++++++------ t/op/infnan.t | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++++------ 3 files changed, 98 insertions(+), 15 deletions(-) diff --git a/pp.c b/pp.c index 18c3f03..55439f3 100644 --- a/pp.c +++ b/pp.c @@ -2842,7 +2842,9 @@ PP(pp_int) } else { const NV value = SvNV_nomg(sv); - if (value >= 0.0) { + if (SvNOK(sv) && Perl_isinfnan(SvNV(sv))) + SETn(SvNV(sv)); + else if (value >= 0.0) { if (value < (NV)UV_MAX + 0.5) { SETu(U_V(value)); } else { diff --git a/sv.c b/sv.c index 1a2f071..ffa9c01 100644 --- a/sv.c +++ b/sv.c @@ -2063,6 +2063,30 @@ S_sv_2iuv_non_preserve(pTHX_ SV *const sv } #endif /* !NV_PRESERVES_UV*/ +/* If numtype is infnan, set the NV of the sv accordingly. + * If numtype is anything else, set the NV using Atof(PV). */ +static void +S_sv_setnv(SV* sv, int numtype) +{ + bool pok = SvPOK(sv); + if ((numtype & IS_NUMBER_INFINITY)) { + SvNV_set(sv, (numtype & IS_NUMBER_NEG) ? -NV_INF : NV_INF); + SvNOK_only(sv); + if (pok) + SvPOK_on(sv); + } + else if ((numtype & IS_NUMBER_NAN)) { + SvNV_set(sv, NV_NAN); + SvNOK_only(sv); + if (pok) + SvPOK_on(sv); + } + else if (pok) + SvNV_set(sv, Atof(SvPVX_const(sv))); + else + return; +} + STATIC bool S_sv_2iuv_common(pTHX_ SV *const sv) { @@ -2176,6 +2200,11 @@ S_sv_2iuv_common(pTHX_ SV *const sv) } else if (SvTYPE(sv) < SVt_PVNV) sv_upgrade(sv, SVt_PVNV); + if ((numtype & (IS_NUMBER_INFINITY | IS_NUMBER_NAN))) { + S_sv_setnv(sv, numtype); + return FALSE; + } + /* If NVs preserve UVs then we only use the UV value if we know that we aren't going to call atof() below. If NVs don't preserve UVs then the value returned may have more precision than atof() will @@ -2221,7 +2250,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv) if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT)) != IS_NUMBER_IN_UV) { /* It wasn't an (integer that doesn't overflow the UV). */ - SvNV_set(sv, Atof(SvPVX_const(sv))); + S_sv_setnv(sv, numtype); if (! numtype && ckWARN(WARN_NUMERIC)) not_a_number(sv); @@ -2623,12 +2652,7 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags) /* It's definitely an integer */ SvNV_set(sv, (numtype & IS_NUMBER_NEG) ? -(NV)value : (NV)value); } else { - if ((numtype & IS_NUMBER_INFINITY)) - SvNV_set(sv, (numtype & IS_NUMBER_NEG) ? -NV_INF : NV_INF); - else if ((numtype & IS_NUMBER_NAN)) - SvNV_set(sv, NV_NAN); - else - SvNV_set(sv, Atof(SvPVX_const(sv))); + S_sv_setnv(sv, numtype); } if (numtype) SvNOK_on(sv); diff --git a/t/op/infnan.t b/t/op/infnan.t index cc275d8..a3f94aa 100644 --- a/t/op/infnan.t +++ b/t/op/infnan.t @@ -56,11 +56,20 @@ cmp_ok(-$NInf, '==', $PInf, "--negative == positive"); is($PInf, "Inf", "$PInf value stringifies as Inf"); is($NInf, "-Inf", "$NInf value stringifies as -Inf"); +cmp_ok($PInf + 0, '==', $PInf, "+Inf + zero is +Inf"); +cmp_ok($NInf + 0, '==', $NInf, "-Inf + zero is -Inf"); + +cmp_ok($PInf + 1, '==', $PInf, "+Inf + one is +Inf"); +cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf"); + +cmp_ok($PInf + $PInf, '==', $PInf, "+Inf + Inf is +Inf"); +cmp_ok($NInf + $NInf, '==', $NInf, "-Inf - Inf is -Inf"); + cmp_ok($PInf * 2, '==', $PInf, "twice Inf is Inf"); cmp_ok($PInf / 2, '==', $PInf, "half of Inf is Inf"); -cmp_ok($PInf + 1, '==', $PInf, "Inf + one is Inf"); -cmp_ok($NInf + 1, '==', $NInf, "-Inf + one is -Inf"); +cmp_ok($PInf * $PInf, '==', $PInf, "-Inf * +Inf is +Inf"); +cmp_ok($NInf * $NInf, '==', $PInf, "-Inf * -Inf is +Inf"); is(sprintf("%g", $PInf), "Inf", "$PInf sprintf %g is Inf"); is(sprintf("%a", $PInf), "Inf", "$PInf sprintf %a is Inf"); @@ -132,11 +141,43 @@ is($NInfMM, $NInf, "-Inf-- is -Inf"); ok($PInf, "+Inf is true"); ok($NInf, "-Inf is true"); +is(abs($PInf), $PInf, "abs(+Inf) is +Inf"); +is(abs($NInf), $PInf, "abs(-Inf) is +Inf"); + +# One could argue of NaN as the result. +is(int($PInf), $PInf, "int(+Inf) is +Inf"); +is(int($NInf), $NInf, "int(-Inf) is -Inf"); + is(sqrt($PInf), $PInf, "sqrt(+Inf) is +Inf"); +# sqrt $NInf doesn't work because negative is caught + is(exp($PInf), $PInf, "exp(+Inf) is +Inf"); is(exp($NInf), 0, "exp(-Inf) is zero"); SKIP: { + if ($PInf == 0) { + skip "if +Inf == 0 cannot log(+Inf)", 1; + } + is(log($PInf), $PInf, "log(+Inf) is +Inf"); +} +# log $NInf doesn't work because negative is caught + +is(rand($PInf), $PInf, "rand(+Inf) is +Inf"); +is(rand($NInf), $NInf, "rand(-Inf) is -Inf"); + +# XXX Bit operations? +# +Inf & 1 == +Inf? +# +Inf | 1 == +Inf? +# +Inf ^ 1 == +Inf? +# ~+Inf == 0? or NaN? +# -Inf ... ??? +# NaN & 1 == NaN? +# NaN | 1 == NaN? +# NaN ^ 1 == NaN? +# ~NaN == NaN??? +# Or just declare insanity and die? + +SKIP: { my $here = "$^O $Config{osvers}"; if ($here =~ /^hpux 10/) { skip "$here: pow doesn't generate Inf", 1; @@ -166,10 +207,15 @@ 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 + zero is NaN"); + +is($NaN + 1, $NaN, "NaN + one 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 * $NaN, $NaN, "NaN * NaN is NaN"); +is($NaN / $NaN, $NaN, "NaN / NaN is NaN"); for my $f (@printf_fmt) { is(sprintf("%$f", $NaN), "NaN", "$NaN sprintf %$f is NaN"); @@ -212,16 +258,27 @@ 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"); +is($NaNPP, $NaN, "+NaN++ is NaN"); +is($NaNMM, $NaN, "+NaN-- is NaN"); # 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(abs($NaN), $NaN, "abs(NaN) is NaN"); +is(int($NaN), $NaN, "int(NaN) is NaN"); is(sqrt($NaN), $NaN, "sqrt(NaN) is NaN"); is(exp($NaN), $NaN, "exp(NaN) is NaN"); + +SKIP: { + if ($NaN == 0) { + skip "if +NaN == 0 cannot log(+NaN)", 1; + } + is(log($NaN), $NaN, "log(NaN) is NaN"); +} + is(sin($NaN), $NaN, "sin(NaN) is NaN"); +is(rand($NaN), $NaN, "rand(NaN) is NaN"); SKIP: { my $here = "$^O $Config{osvers}"; @@ -245,9 +302,9 @@ 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 lt -Inf"); ok(!($NaN == $NInf), "NaN is not eq -Inf"); -ok(!($NaN < $NInf), "NaN is not gt -Inf"); +ok(!($NaN > $NInf), "NaN is not gt -Inf"); is(sin($PInf), $NaN, "sin(+Inf) is NaN"); -- Perl5 Master Repository
