This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #3105] Make 1..3 modification safe
authorFather Chrysostomos <sprout@cpan.org>
Sun, 23 Jun 2013 01:46:00 +0000 (18:46 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 26 Jul 2013 06:48:00 +0000 (23:48 -0700)
This construct is optimised at compile time to an anonymous array with
an implicit @{} around it if both arguments are constant.  Modifying
elements of that array produces wrong results the next time the same
code is executed.

If we mark each element of the array as PADTMP, then it will be
treated like an operator’s return value (which it is) and get copied
as appropriate.

op.c
t/op/range.t
t/op/svleak.t

diff --git a/op.c b/op.c
index f7cfe39..dc8cf22 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3353,6 +3353,8 @@ S_gen_constant_list(pTHX_ OP *o)
     dVAR;
     OP *curop;
     const I32 oldtmps_floor = PL_tmps_floor;
+    SV **svp;
+    AV *av;
 
     list(o);
     if (PL_parser && PL_parser->error_count)
@@ -3375,7 +3377,11 @@ S_gen_constant_list(pTHX_ OP *o)
     o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */
     o->op_opt = 0;             /* needs to be revisited in rpeep() */
     curop = ((UNOP*)o)->op_first;
-    ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc_NN(*PL_stack_sp--));
+    av = (AV *)SvREFCNT_inc_NN(*PL_stack_sp--);
+    ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, (SV *)av);
+    if (AvFILLp(av) != -1)
+       for (svp = AvARRAY(av) + AvFILLp(av); svp >= AvARRAY(av); --svp)
+           SvPADTMP_on(*svp);
 #ifdef PERL_MAD
     op_getmad(curop,o,'O');
 #else
index 264d19a..903cdee 100644 (file)
@@ -390,20 +390,16 @@ is(stores($x), 0);
 
 is( ( join ' ', map { join '', map ++$_, ($x=1)..4 } 1..2 ), '2345 2345',
     'modifiable variable num range' );
-$::TODO = ' ';;
 is( ( join ' ', map { join '', map ++$_, 1..4      } 1..2 ), '2345 2345',
-    'modifiable const num range' );  # Unresolved bug RT#3105
-undef $::TODO;
+    'modifiable const num range' );  # RT#3105
 $s = ''; for (1..2) { for (1..4) { $s .= ++$_ } $s.=' ' if $_==1; }
 is( $s, '2345 2345','modifiable num counting loop counter' );
 
 
 is( ( join ' ', map { join '', map ++$_, ($x='a')..'d' } 1..2 ), 'bcde bcde',
     'modifiable variable alpha range' );
-$::TODO = ' ';
 is( ( join ' ', map { join '', map ++$_, 'a'..'d'      } 1..2 ), 'bcde bcde',
-    'modifiable const alpha range' );  # Unresolved bug RT#3105
-undef $::TODO;
+    'modifiable const alpha range' );  # RT#3105
 $s = ''; for (1..2) { for ('a'..'d') { $s .= ++$_ } $s.=' ' if $_==1; }
 is( $s, 'bcde bcde','modifiable alpha counting loop counter' );
 
index b1a5b32..fbd7083 100644 (file)
@@ -159,36 +159,43 @@ leak_expr(5, 0, q{"YYYYYa" =~ /.+?(a(.+?)|b)/ }, "trie leak");
     my $s;
     my @a;
     my @count = (0) x 4; # pre-allocate
-
-    grep qr/1/ && ($count[$_] = sv_count()) && 99,  0..3;
+    # Using 0..3 with constant endpoints will cause an erroneous test fail-
+    # ure, as the SV in the op tree needs to be copied (to protect it),
+    # but copying happens *during iteration*, causing the number of SVs to
+    # go up.  Using a variable (0..$_3) will cause evaluation of the range
+    # operator at run time, not compile time, so the values will already be
+    # on the stack before grep starts.
+    my $_3 = 3;
+
+    grep qr/1/ && ($count[$_] = sv_count()) && 99,  0..$_3;
     is(@count[3] - @count[0], 0, "void   grep expr:  no new tmps per iter");
-    grep { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..3;
+    grep { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..$_3;
     is(@count[3] - @count[0], 0, "void   grep block: no new tmps per iter");
 
-    $s = grep qr/1/ && ($count[$_] = sv_count()) && 99,  0..3;
+    $s = grep qr/1/ && ($count[$_] = sv_count()) && 99,  0..$_3;
     is(@count[3] - @count[0], 0, "scalar grep expr:  no new tmps per iter");
-    $s = grep { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..3;
+    $s = grep { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..$_3;
     is(@count[3] - @count[0], 0, "scalar grep block: no new tmps per iter");
 
-    @a = grep qr/1/ && ($count[$_] = sv_count()) && 99,  0..3;
+    @a = grep qr/1/ && ($count[$_] = sv_count()) && 99,  0..$_3;
     is(@count[3] - @count[0], 0, "list   grep expr:  no new tmps per iter");
-    @a = grep { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..3;
+    @a = grep { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..$_3;
     is(@count[3] - @count[0], 0, "list   grep block: no new tmps per iter");
 
 
-    map qr/1/ && ($count[$_] = sv_count()) && 99,  0..3;
+    map qr/1/ && ($count[$_] = sv_count()) && 99,  0..$_3;
     is(@count[3] - @count[0], 0, "void   map expr:  no new tmps per iter");
-    map { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..3;
+    map { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..$_3;
     is(@count[3] - @count[0], 0, "void   map block: no new tmps per iter");
 
-    $s = map qr/1/ && ($count[$_] = sv_count()) && 99,  0..3;
+    $s = map qr/1/ && ($count[$_] = sv_count()) && 99,  0..$_3;
     is(@count[3] - @count[0], 0, "scalar map expr:  no new tmps per iter");
-    $s = map { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..3;
+    $s = map { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..$_3;
     is(@count[3] - @count[0], 0, "scalar map block: no new tmps per iter");
 
-    @a = map qr/1/ && ($count[$_] = sv_count()) && 99,  0..3;
+    @a = map qr/1/ && ($count[$_] = sv_count()) && 99,  0..$_3;
     is(@count[3] - @count[0], 3, "list   map expr:  one new tmp per iter");
-    @a = map { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..3;
+    @a = map { qr/1/ && ($count[$_] = sv_count()) && 99 }  0..$_3;
     is(@count[3] - @count[0], 3, "list   map block: one new tmp per iter");
 
 }