diff options
author | Father Chrysostomos <sprout@cpan.org> | 2014-10-03 19:50:45 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2014-10-11 00:10:16 -0700 |
commit | 3ad7d3042169c5402b34cdc33048c5488be19f2c (patch) | |
tree | 20e2cef6c30ac9cb4bb365f9c4fe5f6f9c9b4f11 | |
parent | 30bccb25bef4aaad4b320bff7a818e513dd280f5 (diff) | |
download | perl-3ad7d3042169c5402b34cdc33048c5488be19f2c.tar.gz |
Handle state vars correctly in ref assignment
Only \state(@_) was handling this correctly, as pp_lvavref
calls pp_padav.
-rw-r--r-- | lib/B/Op_private.pm | 2 | ||||
-rw-r--r-- | op.c | 5 | ||||
-rw-r--r-- | opcode.h | 14 | ||||
-rw-r--r-- | pp.c | 5 | ||||
-rw-r--r-- | regen/op_private | 2 | ||||
-rw-r--r-- | t/op/lvref.t | 26 |
6 files changed, 33 insertions, 21 deletions
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 31cac82690..5586ec7bb3 100644 --- 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); @@ -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; @@ -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), @@ -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 c62ba53897..94f1a9a10b 100644 --- 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 c01844841e..894a0b54db 100644 --- 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) { |