diff options
| -rw-r--r-- | op.c | 38 | ||||
| -rw-r--r-- | pp.c | 6 | ||||
| -rw-r--r-- | pp_hot.c | 3 | ||||
| -rw-r--r-- | t/op/sub_lval.t | 32 |
4 files changed, 33 insertions, 46 deletions
@@ -1777,29 +1777,6 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) while (kid->op_sibling) kid = kid->op_sibling; if (!(kid->op_type == OP_NULL && kid->op_targ == OP_RV2CV)) { - /* Indirect call */ - if (kid->op_type == OP_METHOD_NAMED - || kid->op_type == OP_METHOD) - { - UNOP *newop; - - NewOp(1101, newop, 1, UNOP); - newop->op_type = OP_RV2CV; - newop->op_ppaddr = PL_ppaddr[OP_RV2CV]; - newop->op_first = NULL; - newop->op_next = (OP*)newop; - kid->op_sibling = (OP*)newop; - newop->op_private |= OPpLVAL_INTRO; - newop->op_private &= ~1; - break; - } - - if (kid->op_type != OP_RV2CV) - Perl_croak(aTHX_ - "panic: unexpected lvalue entersub " - "entry via type/targ %ld:%"UVuf, - (long)kid->op_type, (UV)kid->op_targ); - kid->op_private |= OPpLVAL_INTRO; break; /* Postpone until runtime */ } @@ -1813,25 +1790,12 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) "entry via type/targ %ld:%"UVuf, (long)kid->op_type, (UV)kid->op_targ); if (kid->op_type != OP_GV) { - /* Restore RV2CV to check lvalueness */ - restore_2cv: - if (kid->op_next && kid->op_next != kid) { /* Happens? */ - okid->op_next = kid->op_next; - kid->op_next = okid; - } - else - okid->op_next = NULL; - okid->op_type = OP_RV2CV; - okid->op_targ = 0; - okid->op_ppaddr = PL_ppaddr[OP_RV2CV]; - okid->op_private |= OPpLVAL_INTRO; - okid->op_private &= ~1; break; } cv = GvCV(kGVOP_gv); if (!cv) - goto restore_2cv; + break; if (CvLVALUE(cv)) break; } @@ -414,12 +414,6 @@ PP(pp_rv2cv) if (cv) { if (CvCLONE(cv)) cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv)))); - if ((PL_op->op_private & OPpLVAL_INTRO)) { - if (gv && GvCV(gv) == cv && (gv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), GvNAMEUTF8(gv) ? SVf_UTF8 : 0))) - cv = GvCV(gv); - if (!CvLVALUE(cv)) - DIE(aTHX_ "Can't modify non-lvalue subroutine call"); - } } else if ((flags == (GV_ADD|GV_NOEXPAND)) && gv && SvROK(gv)) { cv = MUTABLE_CV(gv); @@ -2714,6 +2714,9 @@ try_autoload: MARK++; } } + if ((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO && + !CvLVALUE(cv)) + DIE(aTHX_ "Can't modify non-lvalue subroutine call"); /* warning must come *after* we fully set up the context * stuff so that __WARN__ handlers can safely dounwind() * if they want to diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t index ac3aaf3a5e..7008caf40a 100644 --- a/t/op/sub_lval.t +++ b/t/op/sub_lval.t @@ -3,7 +3,7 @@ BEGIN { @INC = '../lib'; require './test.pl'; } -plan tests=>181; +plan tests=>187; sub a : lvalue { my $a = 34; ${\(bless \$a)} } # Return a temporary sub b : lvalue { ${\shift} } @@ -333,7 +333,7 @@ eval <<'EOE' or $_ = $@; 1; EOE -is($_, undef, "returning a temp from an lvalue sub in scalar context"); +like($_, qr/Can\'t modify non-lvalue subroutine call at /); $_ = undef; eval <<'EOE' or $_ = $@; @@ -341,7 +341,7 @@ eval <<'EOE' or $_ = $@; 1; EOE -is($_, undef, "returning a temp from an lvalue sub in list context"); +like($_, qr/Can\'t modify non-lvalue subroutine call at /); sub yyy () { 'yyy' } # Const, not lvalue @@ -422,6 +422,13 @@ eval 'sub AUTOLOAD : lvalue { $newvar }'; foobar() = 12; is($newvar, "12"); +# But autoloading should only be triggered by a call to an undefined +# subroutine. +&{"lv1nn"} = 14; +is $newvar, 12, 'AUTOLOAD does not take precedence over lvalue sub'; +eval { &{"xxx"} = 14 }; +is $newvar, 12, 'AUTOLOAD does not take precedence over non-lvalue sub'; + { my %hash; my @array; sub alv : lvalue { $array[1] } @@ -918,3 +925,22 @@ is $x = squebble, $], 'returning ro from nested lv sub call in rv cx'; is $x = squabble, $], 'explct. returning ro from nested lv sub in rv cx'; is \squebble, \$], 'returning ro from nested lv sub call in ref cx'; is \squabble, \$], 'explct. returning ro from nested lv sub in ref cx'; + +# [perl #102486] Sub calls as the last statement of an lvalue sub +package _102486 { + my $called; + my $x = 'nonlv'; + sub strictlv :lvalue { use strict 'refs'; &$x } + sub lv :lvalue { &$x } + sub nonlv { ++$called } + eval { strictlv }; + ::like $@, qr/^Can't use string \("nonlv"\) as a subroutine ref while/, + 'strict mode applies to sub:lvalue{ &$string }'; + $called = 0; + ::ok eval { lv }, + 'sub:lvalue{&$x}->() does not die for non-lvalue inner sub call'; + ::is $called, 1, 'The &$x actually called the sub'; + eval { +sub :lvalue { &$x }->() = 3 }; + ::like $@, qr/^Can't modify non-lvalue subroutine call at /, + 'sub:lvalue{&$x}->() dies in true lvalue context'; +} |