Perl_ck_refassign: support refassigning into a state variable

Prior to this commit, Perl_ck_refassign did not check if the
target was a state variable and, if so, wrap it in a ONCE op
so that the RHS is only evaluated once.

diff --git a/op.c b/op.c
index e0dfca5..05c2b54 100644 (file)
--- a/op.c
+++ b/op.c
@@ -13263,7 +13263,8 @@ Perl_ck_refassign(pTHX_ OP *o)
       settarg:
         o->op_private |= (varop->op_private & (OPpLVAL_INTRO|OPpPAD_STATE));
         o->op_targ = varop->op_targ;
-        varop->op_targ = 0;
+        if (!(o->op_private & (OPpPAD_STATE|OPpLVAL_INTRO)))
+            varop->op_targ = 0;
         PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
         break;
 
@@ -13337,6 +13338,9 @@ Perl_ck_refassign(pTHX_ OP *o)
         o->op_flags &=~ OPf_STACKED;
         op_sibling_splice(o, right, 1, NULL);
     }
+    if (o->op_private & OPpPAD_STATE && o->op_private & OPpLVAL_INTRO) {
+        o = S_newONCEOP(aTHX_ o, varop);
+    }
     op_free(left);
     return o;
 }

diff --git a/t/op/lvref.t b/t/op/lvref.t
index f96d949..f589468 100644 (file)
--- a/t/op/lvref.t
+++ b/t/op/lvref.t
@@ -5,7 +5,7 @@ BEGIN {
     set_up_inc("../lib");
 }
 
-plan 167;
+plan 170;
 
 eval '\$x = \$y';
 like $@, qr/^Experimental aliasing via reference not enabled/,
@@ -76,11 +76,13 @@ for (1,2) {
   \my($y) = \3,
   \state $a = \3,
   \state($b) = \3 if $_ == 1;
+  \state $c = \$_;
   if ($_ == 2) {
     is $x, undef, '\my $x = ... clears $x on scope exit';
     is $y, undef, '\my($x) = ... clears $x on scope exit';
     is $a, 3, '\state $x = ... does not clear $x on scope exit';
     is $b, 3, '\state($x) = ... does not clear $x on scope exit';
+    is $c, 1, '\state $x = ... can be used with refaliasing';
   }
 }
 
@@ -210,11 +212,13 @@ for (1,2) {
   \my(@y) = \3,
   \state @a = [1..3],
   \state(@b) = \3 if $_ == 1;
+  \state @c = [$_];
   if ($_ == 2) {
     is @x, 0, '\my @x = ... clears @x on scope exit';
     is @y, 0, '\my(@x) = ... clears @x on scope exit';
     is "@a", "1 2 3", '\state @x = ... does not clear @x on scope exit';
     is "@b", 3, '\state(@x) = ... does not clear @x on scope exit';
+    is $c[0], 1, '\state @x = ... can be used with refaliasing';
   }
 }
 
@@ -254,9 +258,11 @@ package HashTest {
 for (1,2) {
   \state %y = {1,2},
   \my %x = {1,2} if $_ == 1;
+  \state %c = {X => $_};
   if ($_ == 2) {
     is %x, 0, '\my %x = ... clears %x on scope exit';
     is "@{[%y]}", "1 2", '\state %x = ... does not clear %x on scope exit';
+    is $c{X}, 1, '\state %x = ... can be used with refaliasing';
   }
 }