mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

Call get-magic once for .. in list context

Browse Source 
In addition to using _nomg calls in pp_flop, I had to modify
looks_like_number, which was clearly buggy: it was ignoring get-magic
completely, *except* in the case of SvPOKp.  But checking SvPOKp
before calling magic does not make sense, as it may change during the
magic call.
This commit is contained in:
Father Chrysostomos 2011-10-13 00:11:45 -07:00
parent f3dab52a51
commit f52e41ad9f
4 changed files with 37 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
pp_ctl.c
View File

@ -1312,11 +1312,11 @@ PP(pp_flop)
if (RANGE_IS_NUMERIC(left,right)) {
register IV i, j;
IV max;
if ((SvOK(left) && SvNV(left) < IV_MIN) ||
(SvOK(right) && SvNV(right) > IV_MAX))
if ((SvOK(left) && SvNV_nomg(left) < IV_MIN) ||
(SvOK(right) && SvNV_nomg(right) > IV_MAX))
DIE(aTHX_ "Range iterator outside integer range");
i = SvIV(left);
max = SvIV(right);
i = SvIV_nomg(left);
max = SvIV_nomg(right);
if (max >= i) {
j = max - i + 1;
EXTEND_MORTAL(j);
@ -1331,9 +1331,10 @@ PP(pp_flop)
}
else {
STRLEN len;
const char * const tmps = SvPV_const(right, len);
const char * const tmps = SvPV_nomg_const(right, len);
SV *sv = sv_mortalcopy(left);
SV *sv = sv_newmortal();
sv_setsv_nomg(sv, left);
SvPV_force_nolen(sv);
while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
XPUSHs(sv);
@ -2210,27 +2211,28 @@ PP(pp_enteriter)
assumptions */
assert(CxTYPE(cx) == CXt_LOOP_LAZYIV);
#ifdef NV_PRESERVES_UV
if ((SvOK(sv) && ((SvNV(sv) < (NV)IV_MIN) ||
(SvNV(sv) > (NV)IV_MAX)))
if ((SvOK(sv) && ((SvNV_nomg(sv) < (NV)IV_MIN) ||
(SvNV_nomg(sv) > (NV)IV_MAX)))
||
(SvOK(right) && ((SvNV(right) > (NV)IV_MAX) ||
(SvNV(right) < (NV)IV_MIN))))
(SvOK(right) && ((SvNV_nomg(right) > (NV)IV_MAX) ||
(SvNV_nomg(right) < (NV)IV_MIN))))
#else
if ((SvOK(sv) && ((SvNV(sv) <= (NV)IV_MIN)
if ((SvOK(sv) && ((SvNV_nomg(sv) <= (NV)IV_MIN)
||
((SvNV(sv) > 0) &&
((SvUV(sv) > (UV)IV_MAX) ||
(SvNV(sv) > (NV)UV_MAX)))))
((SvNV_nomg(sv) > 0) &&
((SvUV_nomg(sv) > (UV)IV_MAX) ||
(SvNV_nomg(sv) > (NV)UV_MAX)))))
||
(SvOK(right) && ((SvNV(right) <= (NV)IV_MIN)
(SvOK(right) && ((SvNV_nomg(right) <= (NV)IV_MIN)
||
((SvNV(right) > 0) &&
((SvUV(right) > (UV)IV_MAX) ||
(SvNV(right) > (NV)UV_MAX))))))
((SvNV_nomg(right) > 0) &&
((SvUV_nomg(right) > (UV)IV_MAX) ||
(SvNV_nomg(right) > (NV)UV_MAX))
))))
#endif
DIE(aTHX_ "Range iterator outside integer range");
cx->blk_loop.state_u.lazyiv.cur = SvIV(sv);
cx->blk_loop.state_u.lazyiv.end = SvIV(right);
cx->blk_loop.state_u.lazyiv.cur = SvIV_nomg(sv);
cx->blk_loop.state_u.lazyiv.end = SvIV_nomg(right);
#ifdef DEBUGGING
/* for correct -Dstv display */
cx->blk_oldsp = sp - PL_stack_base;

10
sv.c
View File

@ -1785,7 +1785,8 @@ S_not_a_number(pTHX_ SV *const sv)
Test if the content of an SV looks like a number (or is a number).
C<Inf> and C<Infinity> are treated as numbers (so will not issue a
non-numeric warning), even if your atof() doesn't grok them.
non-numeric warning), even if your atof() doesn't grok them. Get-magic is
ignored.
=cut
*/
@ -1798,12 +1799,9 @@ Perl_looks_like_number(pTHX_ SV *const sv)
PERL_ARGS_ASSERT_LOOKS_LIKE_NUMBER;
if (SvPOK(sv)) {
sbegin = SvPVX_const(sv);
len = SvCUR(sv);
if (SvPOK(sv) || SvPOKp(sv)) {
sbegin = SvPV_nomg_const(sv, len);
}
else if (SvPOKp(sv))
sbegin = SvPV_const(sv, len);
else
return SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK);
return grok_number(sbegin, len, NULL);

25
t/op/range.t
View File

@ -355,28 +355,19 @@ my @foo;
@foo = 4 .. $x;
is(scalar @foo, 3);
is("@foo", "4 5 6");
{
local $TODO = "test for double magic with range operator";
is(fetches($x), 1);
}
is(fetches($x), 1);
is(stores($x), 0);
@foo = $x .. 8;
is(scalar @foo, 3);
is("@foo", "6 7 8");
{
local $TODO = "test for double magic with range operator";
is(fetches($x), 1);
}
is(fetches($x), 1);
is(stores($x), 0);
@foo = $x .. $x + 1;
is(scalar @foo, 2);
is("@foo", "6 7");
{
local $TODO = "test for double magic with range operator";
is(fetches($x), 2);
}
is(fetches($x), 2);
is(stores($x), 0);
@foo = ();
@ -385,10 +376,7 @@ for (4 .. $x) {
}
is(scalar @foo, 3);
is("@foo", "4 5 6");
{
local $TODO = "test for double magic with range operator";
is(fetches($x), 1);
}
is(fetches($x), 1);
is(stores($x), 0);
@foo = ();
@ -397,10 +385,7 @@ for (reverse 4 .. $x) {
}
is(scalar @foo, 3);
is("@foo", "6 5 4");
{
local $TODO = "test for double magic with range operator";
is(fetches($x), 1);
}
is(fetches($x), 1);
is(stores($x), 0);
is( ( join ' ', map { join '', map ++$_, ($x=1)..4 } 1..2 ), '2345 2345',

7
t/op/tie_fetch_count.t
View File

@ -7,7 +7,7 @@ BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
plan (tests => 283);
plan (tests => 287);
}
use strict;
@ -62,6 +62,11 @@ $dummy = $var >> 1 ; check_count '>>';
$dummy = $var x 1 ; check_count 'x';
@dummy = ($var) x 1 ; check_count 'x';
$dummy = $var . 1 ; check_count '.';
@dummy = $var .. 1 ; check_count '$tied..1';
@dummy = 1 .. $var; check_count '1..$tied';
tie my $v42 => 'main', "z";
@dummy = $v42 .. "a"; check_count '$tied.."a"';
@dummy = "a" .. $v42; check_count '"a"..$tied';
# Pre/post in/decrement
$var ++ ; check_count 'post ++';