This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop flip from returning the same scalar each time
authorFather Chrysostomos <sprout@cpan.org>
Tue, 23 Sep 2014 04:48:48 +0000 (21:48 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 23 Sep 2014 04:56:36 +0000 (21:56 -0700)
sub f {
  for my $n (1..5) {
    my $x = \scalar($n == 2 .. $n == 4);
    $_ = $x if $n == 1;
    print "$n: $$_\n";
  }
  print("-----\n"), f() if @_
}
f(1);

Output:

1:
2: 1
3: 2
4: 3E0
5:
-----
1:
2:
3:
4:
5:

When f() is called, it evaluates a flipflop five times.  It takes a
reference to the return value the first time, and prints that same
scalar for each iteration.

Notice how the very same scalar is returned each time in the outer sub
call, but the recursive call hides that implementation detail.

.. should not be returning the same scalar each time, or at least that
implementation detail should not leak through.  (Most operators do
reuse the same scalar, but the scalar is flagged such that \ will copy
it, hiding that fact.)

This was happening because of the eccentric way that the flipflop
targets are allocated in the pad.  They are allocated as PADMY (i.e.,
like ‘my’ variables), but without a name.  pad_push (which creates a
new pad for recursion) assumes that anything without a name is PADTMP
instead (copy on reference).  So the recursive call behaves correctly.

I am not sure why the targets were allocated with PADMY to begin with.
(This goes back to perl 5.000.)  But now the PADMY prevents the tar-
gets from being shared with other ops under USE_PAD_RESET builds.

The better way to allocate these targets is to use PADMY as before,
but actually give those slots names.  The target that gets returned
needs to be marked PADTMP, so we also need to copy that flag
in pad_push.

op.c
pad.c
t/op/flip.t

diff --git a/op.c b/op.c
index 3625bc3..42f73ed 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6363,10 +6363,12 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
     left->op_next = flip;
     right->op_next = flop;
 
-    range->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
+    range->op_targ = pad_add_name_pvn("$", 1, padadd_NO_DUP_CHECK, 0, 0);
     sv_upgrade(PAD_SV(range->op_targ), SVt_PVNV);
-    flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
+    flip->op_targ = pad_add_name_pvn("$", 1, padadd_NO_DUP_CHECK, 0, 0);;
     sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
+    SvFLAGS(PAD_SV(flip->op_targ)) &=~ SVs_PADMY;
+    SvPADTMP_on(PAD_SV(flip->op_targ));
 
     flip->op_private =  left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
     flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
diff --git a/pad.c b/pad.c
index fafb946..1306a0a 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -2375,7 +2375,11 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
                    else if (sigil == '%')
                        sv = MUTABLE_SV(newHV());
                    else
+                   {
                        sv = newSV(0);
+                       /* For flip-flop targets: */
+                       if (SvPADTMP(oldpad[ix])) SvPADTMP_on(sv);
+                   }
                    av_store(newpad, ix, sv);
                    SvPADMY_on(sv);
                }
index 8526db7..bb1526d 100644 (file)
@@ -4,7 +4,7 @@ BEGIN {
     require "test.pl";
 }
 
-plan(11);
+plan(12);
 
 @a = (1,2,3,4,5,6,7,8,9,10,11,12);
 @b = ();
@@ -62,3 +62,6 @@ $warn = '';
 
 $. = 15;
 ok(scalar(15..0));
+
+push @_, \scalar(0..0) for 1,2;
+isnt $_[0], $_[1], '\scalar($a..$b) gives a different scalar each time';