Call get-magic once for .. in list context

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.

diff --git a/pp_ctl.c b/pp_ctl.c
index b927821..60d4b0e 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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;

diff --git a/sv.c b/sv.c
index 24b934c..e0bcfdf 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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);

diff --git a/t/op/range.t b/t/op/range.t
index a30e6f6..6554938 100644 (file)
--- a/t/op/range.t
+++ b/t/op/range.t
@@ -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',

diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index ed070e0..85d88d6 100644 (file)
--- a/t/op/tie_fetch_count.t
+++ b/t/op/tie_fetch_count.t
@@ -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 ++';