In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/25a8018cf5dd232ceec2e9edcbd1d0a472a3bccd?hp=f9c28d373757224cbb87b86a551afd50f8f361d5>
- Log ----------------------------------------------------------------- commit 25a8018cf5dd232ceec2e9edcbd1d0a472a3bccd Author: Jarkko Hietaniemi <[email protected]> Date: Sun Jan 11 22:57:37 2015 -0500 Test for nan range ends. M t/op/infnan.t commit 415b66b2c58add39fa4cb119f7eafa5164f33298 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Jan 11 22:58:35 2015 -0500 Detect infnan range ends. M pp_ctl.c commit eaa9f768d686671c8a8e374a757a584b67c62fd4 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Jan 11 22:58:15 2015 -0500 Separate bad range end detection. M pp_ctl.c commit 34c2b3960f2e45447def4f7abc0a37f7dc884d64 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Jan 11 22:27:45 2015 -0500 Test for inf range ends. M t/op/infnan.t commit 8d2f77d8a28a02eedb0d7cd7a8aff358b6177739 Author: Jarkko Hietaniemi <[email protected]> Date: Sun Jan 11 22:18:00 2015 -0500 Explicitly test x infnan producing empty string. M t/op/infnan.t ----------------------------------------------------------------------- Summary of changes: pp_ctl.c | 45 ++++++++++++++++++++++++--------------------- t/op/infnan.t | 29 +++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+), 21 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index d69710c..37b822c 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2090,6 +2090,28 @@ PP(pp_leave) RETURN; } +static bool +S_outside_integer(pTHX_ SV *sv) +{ + if (SvOK(sv)) { + const NV nv = SvNV_nomg(sv); + if (Perl_isinfnan(nv)) + return TRUE; +#ifdef NV_PRESERVES_UV + if (nv < (NV)IV_MIN || nv > (NV)IV_MAX) + return TRUE; +#else + if (nv <= (NV)IV_MIN) + return TRUE; + if ((nv > 0) && + ((nv > (NV)UV_MAX || + SvUV_nomg(sv) > (UV)IV_MAX))) + return TRUE; +#endif + } + return FALSE; +} + PP(pp_enteriter) { dSP; dMARK; @@ -2148,32 +2170,13 @@ PP(pp_enteriter) SvGETMAGIC(sv); SvGETMAGIC(right); if (RANGE_IS_NUMERIC(sv,right)) { - NV nv; cx->cx_type &= ~CXTYPEMASK; cx->cx_type |= CXt_LOOP_LAZYIV; /* Make sure that no-one re-orders cop.h and breaks our assumptions */ assert(CxTYPE(cx) == CXt_LOOP_LAZYIV); -#ifdef NV_PRESERVES_UV - if ((SvOK(sv) && (((nv = SvNV_nomg(sv)) < (NV)IV_MIN) || - (nv > (NV)IV_MAX))) - || - (SvOK(right) && (((nv = SvNV_nomg(right)) > (NV)IV_MAX) || - (nv < (NV)IV_MIN)))) -#else - if ((SvOK(sv) && (((nv = SvNV_nomg(sv)) <= (NV)IV_MIN) - || - ((nv > 0) && - ((nv > (NV)UV_MAX) || - (SvUV_nomg(sv) > (UV)IV_MAX))))) - || - (SvOK(right) && (((nv = SvNV_nomg(right)) <= (NV)IV_MIN) - || - ((nv > 0) && - ((nv > (NV)UV_MAX) || - (SvUV_nomg(right) > (UV)IV_MAX)) - )))) -#endif + if (S_outside_integer(aTHX_ sv) || + S_outside_integer(aTHX_ right)) DIE(aTHX_ "Range iterator outside integer range"); cx->blk_loop.state_u.lazyiv.cur = SvIV_nomg(sv); cx->blk_loop.state_u.lazyiv.end = SvIV_nomg(right); diff --git a/t/op/infnan.t b/t/op/infnan.t index 86135a0..bb03fd4 100644 --- a/t/op/infnan.t +++ b/t/op/infnan.t @@ -241,6 +241,21 @@ SKIP: { } } +{ + # Silence "Non-finite repeat count", that is tested elsewhere. + local $^W = 0; + is("a" x $PInf, "", "x +Inf"); + is("a" x $NInf, "", "x -Inf"); +} + +{ + eval 'for my $x (0..$PInf) { last }'; + like($@, qr/Range iterator outside integer range/, "0..+Inf fails"); + + eval 'for my $x ($NInf..0) { last }'; + like($@, qr/Range iterator outside integer range/, "-Inf..0 fails"); +} + # === NaN === cmp_ok($NaN, '!=', $NaN, "NaN is NaN numerically (by not being NaN)"); @@ -358,6 +373,12 @@ SKIP: { } } +{ + # Silence "Non-finite repeat count", that is tested elsewhere. + local $^W = 0; + is("a" x $NaN, "", "x NaN"); +} + # === Tests combining Inf and NaN === # is() okay with $NaN because it uses eq. @@ -378,6 +399,14 @@ ok(!($NaN > $NInf), "NaN is not gt -Inf"); is(sin($PInf), $NaN, "sin(+Inf) is NaN"); +{ + eval 'for my $x (0..$NaN) { last }'; + like($@, qr/Range iterator outside integer range/, "0..NaN fails"); + + eval 'for my $x ($NaN..0) { last }'; + like($@, qr/Range iterator outside integer range/, "NaN..0 fails"); +} + # === Overflows and Underflows === # 1e9999 (and 1e-9999) are large (and small) enough for even -- Perl5 Master Repository
