In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c77ed9ca79ef772961f511a2176824386a19b6d1?hp=a0732aaa4b015e55976f0134a2724c959d528d34>
- Log ----------------------------------------------------------------- commit c77ed9ca79ef772961f511a2176824386a19b6d1 Author: Jarkko Hietaniemi <[email protected]> Date: Thu Sep 18 21:25:42 2014 -0400 Parenthesize & and | a bit. M sv.c M sv.h commit 5d288d736c2758c27a5943647f4a524f0e93a642 Author: Jarkko Hietaniemi <[email protected]> Date: Thu Sep 18 21:10:41 2014 -0400 infnan: more tests. ++, math, compare. M t/op/infnan.t commit dbc3192fe0c49a38126b4e4572de22c8ffff3a3f Author: Jarkko Hietaniemi <[email protected]> Date: Thu Sep 18 21:45:06 2014 -0400 Do not fall into Gconvert or F0convert on inf/nan. Though make F0convert to do the right thing, S_infnan_2pv, on infnan. (found by bulk88) M sv.c commit b5c285ceb87a4fc20152518db1952109dd78749e Author: Jarkko Hietaniemi <[email protected]> Date: Thu Sep 18 21:15:03 2014 -0400 infnan: ++ or -- on infnan doesn't lose precision. (found by bulk88) M sv.c ----------------------------------------------------------------------- Summary of changes: sv.c | 57 ++++++++++++++++++++++++++++-------------------- sv.h | 6 +++--- t/op/infnan.t | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++++---- 3 files changed, 102 insertions(+), 30 deletions(-) diff --git a/sv.c b/sv.c index 9df01b7..3f7fce6 100644 --- a/sv.c +++ b/sv.c @@ -3157,7 +3157,7 @@ Perl_sv_copypv_flags(pTHX_ SV *const dsv, SV *const ssv, const I32 flags) PERL_ARGS_ASSERT_SV_COPYPV_FLAGS; - s = SvPV_flags_const(ssv,len,flags & SV_GMAGIC); + s = SvPV_flags_const(ssv,len,(flags & SV_GMAGIC)); sv_setpvn(dsv,s,len); if (SvUTF8(ssv)) SvUTF8_on(dsv); @@ -8607,7 +8607,8 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv) } if (flags & SVp_NOK) { const NV was = SvNVX(sv); - if (NV_OVERFLOWS_INTEGERS_AT && + if (!Perl_isinfnan(was) && + NV_OVERFLOWS_INTEGERS_AT && was >= NV_OVERFLOWS_INTEGERS_AT) { /* diag_listed_as: Lost precision when %s %f by 1 */ Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION), @@ -8785,7 +8786,8 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv) oops_its_num: { const NV was = SvNVX(sv); - if (NV_OVERFLOWS_INTEGERS_AT && + if (!Perl_isinfnan(was) && + NV_OVERFLOWS_INTEGERS_AT && was <= -NV_OVERFLOWS_INTEGERS_AT) { /* diag_listed_as: Lost precision when %s %f by 1 */ Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION), @@ -10569,6 +10571,11 @@ S_F0convert(NV nv, char *const endbuf, STRLEN *const len) PERL_ARGS_ASSERT_F0CONVERT; + if (Perl_isinfnan(nv)) { + STRLEN n = S_infnan_2pv(nv, endbuf - *len, *len); + *len = n; + return endbuf - n; + } if (neg) nv = -nv; if (nv < UV_MAX) { @@ -11008,26 +11015,28 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p Munged by Nicholas Clark in v5.13.0-209-g95ea86d */ if (pp - pat == (int)patlen - 1 && svix < svmax) { const NV nv = SvNV(*svargs); - if (*pp == 'g') { - /* Add check for digits != 0 because it seems that some - gconverts are buggy in this case, and we don't yet have - a Configure test for this. */ - if (digits && digits < sizeof(ebuf) - NV_DIG - 10) { - /* 0, point, slack */ - STORE_LC_NUMERIC_SET_TO_NEEDED(); - PERL_UNUSED_RESULT(Gconvert(nv, (int)digits, 0, ebuf)); - sv_catpv_nomg(sv, ebuf); - if (*ebuf) /* May return an empty string for digits==0 */ - return; - } - } else if (!digits) { - STRLEN l; + if (LIKELY(!Perl_isinfnan(nv))) { + if (*pp == 'g') { + /* Add check for digits != 0 because it seems that some + gconverts are buggy in this case, and we don't yet have + a Configure test for this. */ + if (digits && digits < sizeof(ebuf) - NV_DIG - 10) { + /* 0, point, slack */ + STORE_LC_NUMERIC_SET_TO_NEEDED(); + PERL_UNUSED_RESULT(Gconvert(nv, (int)digits, 0, ebuf)); + sv_catpv_nomg(sv, ebuf); + if (*ebuf) /* May return an empty string for digits==0 */ + return; + } + } else if (!digits) { + STRLEN l; - if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) { - sv_catpvn_nomg(sv, p, l); - return; - } - } + if ((p = F0convert(nv, ebuf + sizeof ebuf, &l))) { + sv_catpvn_nomg(sv, p, l); + return; + } + } + } } } #endif /* !USE_LONG_DOUBLE */ @@ -11958,7 +11967,8 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p } if ( !(width || left || plus || alt) && fill != '0' - && has_precis && intsize != 'q' ) { /* Shortcuts */ + && has_precis && intsize != 'q' /* Shortcuts */ + && LIKELY(!Perl_isinfnan((NV)fv)) ) { /* See earlier comment about buggy Gconvert when digits, aka precis is 0 */ if ( c == 'g' && precis ) { @@ -12154,6 +12164,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p } else elen = S_infnan_2pv(fv, PL_efloatbuf, PL_efloatsize); + if (elen == 0) { char *ptr = ebuf + sizeof ebuf; *--ptr = '\0'; diff --git a/sv.h b/sv.h index 17a9532..f3d2e4e 100644 --- a/sv.h +++ b/sv.h @@ -1680,15 +1680,15 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv>. #define SvPV_flags_const(sv, lp, flags) \ (SvPOK_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \ - (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN)) + (const char*) sv_2pv_flags(sv, &lp, (flags|SV_CONST_RETURN))) #define SvPV_flags_const_nolen(sv, flags) \ (SvPOK_nog(sv) \ ? SvPVX_const(sv) : \ - (const char*) sv_2pv_flags(sv, 0, flags|SV_CONST_RETURN)) + (const char*) sv_2pv_flags(sv, 0, (flags|SV_CONST_RETURN))) #define SvPV_flags_mutable(sv, lp, flags) \ (SvPOK_nog(sv) \ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \ - sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) + sv_2pv_flags(sv, &lp, (flags|SV_MUTABLE_RETURN))) #define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC) #define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC) diff --git a/t/op/infnan.t b/t/op/infnan.t index b448c2c..101fc24 100644 --- a/t/op/infnan.t +++ b/t/op/infnan.t @@ -34,12 +34,16 @@ my @NaN = ("NAN", "nan", "qnan", "SNAN", "NanQ", "NANS", my @num_fmt = qw(e f g a d u o b x p); -my $inf_tests = 13 + @num_fmt + 8 + 3 * @PInf + 3 * @NInf + 5 + 3; -my $nan_tests = 8 + @num_fmt + 4 + 2 * @NaN + 3; +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 = 4; +my $infnan_tests = 13; -plan tests => $inf_tests + $nan_tests + $infnan_tests; +plan tests => $inf_tests + 1 + $nan_tests + 1 + $infnan_tests + 1; + +print "# inf_tests = $inf_tests\n"; +print "# nan_tests = $nan_tests\n"; +print "# infnan_tests = $infnan_tests\n"; my $has_inf; my $has_nan; @@ -108,6 +112,24 @@ SKIP: { 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"); + + 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"); + SKIP: { my $here = "$^O $Config{osvers}"; if ($here =~ /^hpux 10/) { @@ -125,6 +147,8 @@ SKIP: { } } +is(curr_test() - 1, $inf_tests, "expected number of inf tests"); + SKIP: { if ($NaN == 0) { skip $nan_tests, "no nan found"; @@ -164,10 +188,29 @@ SKIP: { 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 < $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"); + my ($NaNPP, $NaNMM) = ($NaN, $NaN); + $NaNPP++; + $NaNMM--; + is($NaNPP, $NaN, "+inf++ is +inf"); + is($NaNMM, $NaN, "+inf-- is +inf"); + + 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"); + SKIP: { my $here = "$^O $Config{osvers}"; if ($here =~ /^hpux 10/) { @@ -177,6 +220,9 @@ SKIP: { } } +is(curr_test() - 1, $inf_tests + 1 + $nan_tests, + "expected number of nan tests"); + SKIP: { unless ($has_inf && $has_nan) { skip $infnan_tests, "no both Inf and Nan"; @@ -187,4 +233,19 @@ SKIP: { 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"); } + +is(curr_test() - 1, $inf_tests + 1 + $nan_tests + 1 + $infnan_tests, + "expected number of nan tests"); -- Perl5 Master Repository
