summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/B/Op_private.pm2
-rw-r--r--mg.c15
-rw-r--r--op.c11
-rw-r--r--opcode.h4
-rw-r--r--pp.c10
-rw-r--r--regen/op_private2
-rw-r--r--t/op/lvref.t16
7 files changed, 40 insertions, 20 deletions
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 34564a975c..61185f63cd 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -128,7 +128,7 @@ $bits{$_}{5} = 'OPpHUSH_VMSISH' for qw(dbstate nextstate);
$bits{$_}{2} = 'OPpITER_REVERSED' for qw(enteriter iter);
$bits{$_}{7} = 'OPpLVALUE' for qw(leave leaveloop);
$bits{$_}{4} = 'OPpLVAL_DEFER' for qw(aelem helem);
-$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv);
+$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv);
$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice padav padhv pos rkeys rv2av rv2gv rv2hv substr vec);
$bits{$_}{6} = 'OPpMAYBE_TRUEBOOL' for qw(padhv rv2hv);
$bits{$_}{7} = 'OPpOFFBYONE' for qw(caller runcv wantarray);
diff --git a/mg.c b/mg.c
index 2284783625..ff5e47c3e3 100644
--- a/mg.c
+++ b/mg.c
@@ -2469,9 +2469,18 @@ Perl_magic_setlvref(pTHX_ SV *sv, MAGIC *mg)
if (SvTYPE(SvRV(sv)) > SVt_PVLV)
/* diag_listed_as: Assigned value is not %s reference */
Perl_croak(aTHX_ "Assigned value is not a SCALAR reference");
- assert(isGV(mg->mg_obj));
- gv_setref(mg->mg_obj, sv);
- SvSETMAGIC(mg->mg_obj);
+ switch (mg->mg_obj ? SvTYPE(mg->mg_obj) : 0) {
+ case 0:
+ {
+ SV * const old = PAD_SV(mg->mg_len);
+ PAD_SETSV(mg->mg_len, SvREFCNT_inc_NN(SvRV(sv)));
+ SvREFCNT_dec(old);
+ break;
+ }
+ case SVt_PVGV:
+ gv_setref(mg->mg_obj, sv);
+ SvSETMAGIC(mg->mg_obj);
+ }
sv_unmagic(sv, PERL_MAGIC_lvref);
return 0;
}
diff --git a/op.c b/op.c
index d0689d41cd..36b6a924f9 100644
--- a/op.c
+++ b/op.c
@@ -2637,11 +2637,13 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
if (kUNOP->op_first->op_type != OP_GV) goto badref;
if (kid->op_private & OPpLVAL_INTRO)
goto badref; /* XXX temporary */
- op_null(kid);
- o->op_type = OP_LVREF;
- o->op_ppaddr = PL_ppaddr[OP_LVREF];
o->op_flags |= OPf_STACKED;
break;
+ case OP_PADSV:
+ o->op_private = kid->op_private & OPpLVAL_INTRO;
+ o->op_targ = kid->op_targ;
+ kid->op_targ = 0;
+ break;
default:
badref:
/* diag_listed_as: Can't modify %s in %s */
@@ -2656,6 +2658,9 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
Perl_croak(aTHX_ "Experimental lvalue references not enabled");
Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__LVALUE_REFS),
"Lvalue references are experimental");
+ op_null(kid);
+ o->op_type = OP_LVREF;
+ o->op_ppaddr = PL_ppaddr[OP_LVREF];
return o;
}
diff --git a/opcode.h b/opcode.h
index 4a0a91a302..05049e4ab8 100644
--- a/opcode.h
+++ b/opcode.h
@@ -3081,7 +3081,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
/* fc */ 0x0003,
/* padrange */ 0x25bc, 0x019b,
/* refassign */ 0x25bc, 0x0067,
- /* lvref */ 0x0003,
+ /* lvref */ 0x25bc, 0x0003,
};
@@ -3470,7 +3470,7 @@ EXTCONST U8 PL_op_private_valid[] = {
/* CLONECV */ (0),
/* PADRANGE */ (OPpPADRANGE_COUNTMASK|OPpLVAL_INTRO),
/* REFASSIGN */ (OPpARG2_MASK|OPpLVAL_INTRO),
- /* LVREF */ (OPpARG1_MASK),
+ /* LVREF */ (OPpARG1_MASK|OPpLVAL_INTRO),
};
diff --git a/pp.c b/pp.c
index bcfd217fa8..e449791608 100644
--- a/pp.c
+++ b/pp.c
@@ -6194,9 +6194,13 @@ PP(pp_lvref)
{
dSP;
SV * const ret = sv_2mortal(newSV_type(SVt_PVMG));
- sv_magic(ret, TOPs, PERL_MAGIC_lvref, NULL, 0);
- SETs(ret);
- return NORMAL;
+ sv_magic(ret, PL_op->op_flags & OPf_STACKED ? POPs : NULL,
+ PERL_MAGIC_lvref, NULL, ARGTARG);
+ if (!(PL_op->op_flags & OPf_STACKED)
+ && PL_op->op_private & OPpLVAL_INTRO)
+ SAVECLEARSV(PAD_SVl(ARGTARG));
+ XPUSHs(ret);
+ RETURN;
}
/*
diff --git a/regen/op_private b/regen/op_private
index df0e8aaead..6d4e2a0ff7 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -301,7 +301,7 @@ for (qw(nextstate dbstate)) {
addbits($_, 7 => qw(OPpLVAL_INTRO LVINTRO))
for qw(gvsv rv2sv rv2hv rv2gv rv2av aelem helem aslice
hslice delete padsv padav padhv enteriter entersub padrange
- pushmark cond_expr refassign),
+ pushmark cond_expr refassign lvref),
'list', # this gets set in my_attrs() for some reason
;
diff --git a/t/op/lvref.t b/t/op/lvref.t
index ef1a6c2b27..be97fb489a 100644
--- a/t/op/lvref.t
+++ b/t/op/lvref.t
@@ -49,25 +49,27 @@ is \$x, \$_, '\($pkgvar) = ... gives list context';
undef *x;
(\$x) = @_;
is \$x, \$_, '(\$pkgvar) = ... gives list context';
-on;
my $o;
-eval '\($o) = @_';
+\($o) = @_;
is \$o, \$_, '\($lexical) = ... gives list cx';
my $q;
-eval '(\$q) = @_';
+(\$q) = @_;
is \$q, \$_, '(\$lexical) = ... gives list cx';
-eval '\(my $p) = @_';
+\(my $p) = @_;
is \$p, \$_, '\(my $lexical) = ... gives list cx';
-eval '(\my $r) = @_';
+(\my $r) = @_;
is \$r, \$_, '(\my $lexical) = ... gives list cx';
-eval '\my($s) = @_';
+\my($s) = @_;
is \$s, \$_, '\my($lexical) = ... gives list cx';
+on;
eval '\($_a, my $a) = @{[\$b, \$c]}';
is \$_a, \$b, 'package scalar in \(...)';
is \$a, \$c, 'lex scalar in \(...)';
-eval '(\$_b, \my $b) = @{[\$b, \$c]}';
+off;
+(\$_b, \my $b) = @{[\$b, \$c]};
is \$_b, \$::b, 'package scalar in (\$foo, \$bar)';
is \$b, \$c, 'lex scalar in (\$foo, \$bar)';
+on;
is eval '\local $l = \3; $l', 3, '\local $scalar assignment';
off;
is $l, undef, 'localisation unwound';
View Lorry Controller Status