Handle state vars correctly in ref assignment

Only \state(@_) was handling this correctly, as pp_lvavref
calls pp_padav.

diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 31cac82..5586ec7 100644 (file)
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -139,7 +139,7 @@ $bits{$_}{4} = 'OPpOPEN_IN_RAW' for qw(backtick open);
 $bits{$_}{7} = 'OPpOPEN_OUT_CRLF' for qw(backtick open);
 $bits{$_}{6} = 'OPpOPEN_OUT_RAW' for qw(backtick open);
 $bits{$_}{4} = 'OPpOUR_INTRO' for qw(enteriter gvsv rv2av rv2hv rv2sv split);
-$bits{$_}{4} = 'OPpPAD_STATE' for qw(lvavref padav padhv padsv pushmark);
+$bits{$_}{4} = 'OPpPAD_STATE' for qw(lvavref lvref padav padhv padsv pushmark refassign);
 $bits{$_}{7} = 'OPpPV_IS_UTF8' for qw(dump goto last next redo);
 $bits{$_}{6} = 'OPpREFCOUNTED' for qw(leave leaveeval leavesub leavesublv leavewrite);
 $bits{$_}{6} = 'OPpRUNTIME' for qw(match pushre qr subst substcont);

diff --git a/op.c b/op.c
index 23c948c..3d005aa 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2451,7 +2451,8 @@ S_lvref(pTHX_ OP *o, I32 type)
     }
     o->op_type = OP_LVREF;
     o->op_ppaddr = PL_ppaddr[OP_LVREF];
-    o->op_private &= OPpLVAL_INTRO|OPpLVREF_ELEM|OPpLVREF_TYPE;
+    o->op_private &=
+       OPpLVAL_INTRO|OPpLVREF_ELEM|OPpLVREF_TYPE|OPpPAD_STATE;
     if (type == OP_ENTERLOOP)
        o->op_private |= OPpLVREF_ITER;
 }
@@ -10098,7 +10099,7 @@ Perl_ck_refassign(pTHX_ OP *o)
     Perl_ck_warner_d(aTHX_
                     packWARN(WARN_EXPERIMENTAL__LVALUE_REFS),
                    "Lvalue references are experimental");
-    o->op_private |= varop->op_private & OPpLVAL_INTRO;
+    o->op_private |= varop->op_private & (OPpLVAL_INTRO|OPpPAD_STATE);
     if (stacked) o->op_flags |= OPf_STACKED;
     else {
        o->op_flags &=~ OPf_STACKED;

diff --git a/opcode.h b/opcode.h
index eb3dc33..8117fd9 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -2745,9 +2745,9 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       -1, /* clonecv */
      630, /* padrange */
      632, /* refassign */
-     637, /* lvref */
-     642, /* lvrefslice */
-     643, /* lvavref */
+     638, /* lvref */
+     644, /* lvrefslice */
+     645, /* lvavref */
 
 };
 
@@ -3106,8 +3106,8 @@ EXTCONST U16  PL_op_private_bitdefs[] = {
     /* runcv         */ 0x00bd,
     /* fc            */ 0x0003,
     /* padrange      */ 0x281c, 0x019b,
-    /* refassign     */ 0x281c, 0x037a, 0x250c, 0x13e8, 0x0067,
-    /* lvref         */ 0x281c, 0x037a, 0x250c, 0x13e8, 0x0003,
+    /* refassign     */ 0x281c, 0x037a, 0x3a10, 0x250c, 0x13e8, 0x0067,
+    /* lvref         */ 0x281c, 0x037a, 0x3a10, 0x250c, 0x13e8, 0x0003,
     /* lvrefslice    */ 0x281d,
     /* lvavref       */ 0x281c, 0x3a10, 0x0003,
 
@@ -3497,8 +3497,8 @@ EXTCONST U8 PL_op_private_valid[] = {
     /* INTROCV    */ (0),
     /* CLONECV    */ (0),
     /* PADRANGE   */ (OPpPADRANGE_COUNTMASK|OPpLVAL_INTRO),
-    /* REFASSIGN  */ (OPpARG2_MASK|OPpLVREF_ELEM|OPpLVREF_ITER|OPpLVREF_TYPE|OPpLVAL_INTRO),
-    /* LVREF      */ (OPpARG1_MASK|OPpLVREF_ELEM|OPpLVREF_ITER|OPpLVREF_TYPE|OPpLVAL_INTRO),
+    /* REFASSIGN  */ (OPpARG2_MASK|OPpLVREF_ELEM|OPpLVREF_ITER|OPpPAD_STATE|OPpLVREF_TYPE|OPpLVAL_INTRO),
+    /* LVREF      */ (OPpARG1_MASK|OPpLVREF_ELEM|OPpLVREF_ITER|OPpPAD_STATE|OPpLVREF_TYPE|OPpLVAL_INTRO),
     /* LVREFSLICE */ (OPpLVAL_INTRO),
     /* LVAVREF    */ (OPpARG1_MASK|OPpPAD_STATE|OPpLVAL_INTRO),
 

diff --git a/pp.c b/pp.c
index 8ee7f05..c5e8be7 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -6247,7 +6247,8 @@ PP(pp_refassign)
        SV * const old = PAD_SV(ARGTARG);
        PAD_SETSV(ARGTARG, SvREFCNT_inc_NN(SvRV(sv)));
        SvREFCNT_dec(old);
-       if (PL_op->op_private & OPpLVAL_INTRO)
+       if ((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE))
+               == OPpLVAL_INTRO)
            SAVECLEARSV(PAD_SVl(ARGTARG));
        break;
     }
@@ -6304,7 +6305,7 @@ PP(pp_lvref)
        S_localise_gv_slot(aTHX_ (GV *)arg, 
                                 PL_op->op_private & OPpLVREF_TYPE);
       }
-      else
+      else if (!(PL_op->op_private & OPpPAD_STATE))
        SAVECLEARSV(PAD_SVl(ARGTARG));
     }
     XPUSHs(ret);

diff --git a/regen/op_private b/regen/op_private
index c62ba53..94f1a9a 100644 (file)
--- a/regen/op_private
+++ b/regen/op_private
@@ -473,7 +473,7 @@ addbits($_, 7 => qw(OPpPV_IS_UTF8 UTF)) for qw(last redo next goto dump);
 
 
 addbits($_, 4 => qw(OPpPAD_STATE STATE))  for qw(padav padhv padsv lvavref
-                                                 pushmark);
+                                                 lvref refassign pushmark);
 
 
 

diff --git a/t/op/lvref.t b/t/op/lvref.t
index c018448..894a0b5 100644 (file)
--- a/t/op/lvref.t
+++ b/t/op/lvref.t
@@ -4,7 +4,7 @@ BEGIN {
     set_up_inc("../lib");
 }
 
-plan 135;
+plan 140;
 
 sub on { $::TODO = ' ' }
 sub off{ $::TODO = ''  }
@@ -16,7 +16,7 @@ eval '\($x) = \$y';
 like $@, qr/^Experimental lvalue references not enabled/,
     'error when feature is disabled (aassign)';
 
-use feature 'lvalue_refs';
+use feature 'lvalue_refs', 'state';
 
 {
     my($w,$c);
@@ -74,11 +74,15 @@ is $l, undef, 'localisation unwound';
 \$foo = \*bar;
 is *foo{SCALAR}, *bar{GLOB}, 'globref-to-scalarref assignment';
 for (1,2) {
-  \my $x = \3 if $_ == 1;
-  \my($y) = \3 if $_ == 1;
+  \my $x = \3,
+  \my($y) = \3,
+  \state $a = \3,
+  \state($b) = \3 if $_ == 1;
   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';
   }
 }
 
@@ -204,11 +208,15 @@ package ArrayTest {
   is \@i, $old, '(\local @a) unwound';
 }
 for (1,2) {
-  \my @x = [1..3] if $_ == 1;
-  \my(@y) = \3 if $_ == 1;
+  \my @x = [1..3],
+  \my(@y) = \3,
+  \state @a = [1..3],
+  \state(@b) = \3 if $_ == 1;
   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';
   }
 }
 
@@ -246,9 +254,11 @@ package HashTest {
   is \%i, $old, '(\local %a) unwound';
 }
 for (1,2) {
+  \state %y = {1,2},
   \my %x = {1,2} if $_ == 1;
   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';
   }
 }
 
@@ -256,7 +266,7 @@ for (1,2) {
 
 package CodeTest {
   BEGIN { *is = *main::is; }
-  use feature 'lexical_subs', 'state';
+  use feature 'lexical_subs';
   no warnings 'experimental::lexical_subs';
   sub expect_scalar_cx { wantarray ? 0 : \&ThatSub }
   sub expect_list_cx   { wantarray ? (\&ThatSub)x2 : 0 }
@@ -486,7 +496,7 @@ on;
 }
 
 { # PADSTALE has a double meaning
-  use feature 'lexical_subs', 'signatures', 'state';
+  use feature 'lexical_subs', 'signatures';
   no warnings 'experimental';
   my $c;
   my sub s ($arg) {