In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/0865059d9cec0d198515152182d4283ab634748e?hp=422d6414d26e413a69e401207deaf53fb640b369>
- Log ----------------------------------------------------------------- commit 0865059d9cec0d198515152182d4283ab634748e Author: Father Chrysostomos <[email protected]> Date: Sat Jan 28 19:14:39 2012 -0800 [perl #109264] ->method(my(...)) forcing lvalue cx A simple my($foo,$bar) list is flagged as an lvalue: $ ./perl -Ilib -MO=Concise -e 'my($foo,$bar)' 7 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 1 -e:1) v:{ ->3 6 <@> list vKPM/128 ->7 3 <0> pushmark vM/128 ->4 4 <0> padsv[$foo:1,2] vM/LVINTRO ->5 5 <0> padsv[$bar:1,2] vM/LVINTRO ->6 -e syntax OK That 128 that the list op is the same flag as LVINTRO. When a method call is compiled, the list op for the argument list is itself converted into an entersub op. That LVINTRO flag is never turned off. So foo->bar(my($foo,$bar)) becomes this: $ ./perl -Ilib -MO=Concise -e 'foo->bar(my($foo,$bar))' 9 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 1 -e:1) v:{ ->3 8 <1> entersub[t4] vKMS/LVINTRO,TARG ->9 3 <0> pushmark sM/128 ->4 4 <$> const[PV "foo"] sM/BARE ->5 5 <0> padsv[$foo:1,2] lM/LVINTRO ->6 6 <0> padsv[$bar:1,2] lM/LVINTRO ->7 7 <$> method_named[PV "bar"] ->8 -e syntax OK This was rarely a problem until commit da1dff948 added lvalue check- ing for method calls (a fifth bug fix in that commit not mentioned in the commit message). Calling the method will now result in âCan't modify non-lvalue subrou- tine callâ unless the method has the :lvalue attribute. Before that, this would only cause problems with lvalue methods: $ perl -le ' sub clear_queue:lvalue { warn "called"; undef } 3==main->clear_queue(my ($id, $name)) ' called at -e line 2. Can't return undef from lvalue subroutine at -e line 3. Calling it with ($id, $name) was fine, and allowed undef to be returned. Perl_localize in op.c (which is called for my, our and local) calls my() (aka Perl_my_attrs) on the list itself for my or our. Perl_my_attrs was setting flags on the list, not just on its children. So this commit modifies my_attrs not to set any flags on the list op itself. local() was not affected, as it goes through op_lvalue_flags instead of my_attrs, and op_lvalue_flags doesnât set flags on list ops (I mean ops of type OP_LIST, not listops in general). I added tests for it anyway. ----------------------------------------------------------------------- Summary of changes: op.c | 1 + t/op/method.t | 21 ++++++++++++++++++++- 2 files changed, 21 insertions(+), 1 deletions(-) diff --git a/op.c b/op.c index 479d2ba..09f45d0 100644 --- a/op.c +++ b/op.c @@ -2402,6 +2402,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) OP *kid; for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) my_kid(kid, attrs, imopsp); + return o; } else if (type == OP_UNDEF #ifdef PERL_MAD || type == OP_STUB diff --git a/t/op/method.t b/t/op/method.t index 7867095..13547bc 100644 --- a/t/op/method.t +++ b/t/op/method.t @@ -13,7 +13,7 @@ BEGIN { use strict; no warnings 'once'; -plan(tests => 85); +plan(tests => 91); @A::ISA = 'B'; @B::ISA = 'C'; @@ -369,3 +369,22 @@ is $kalled, 1, 'calling a class method via a magic variable'; is eval { "Just"->a_japh }, "Just another Perl hacker,", 'constants do not interfere with class methods'; } + +# [perl #109264] +{ + no strict 'vars'; + sub bliggles { 1 } + sub lbiggles :lvalue { index "foo", "f" } + ok eval { main->bliggles(my($foo,$bar)) }, + 'foo->bar(my($foo,$bar)) is not called in lvalue context'; + ok eval { main->bliggles(our($foo,$bar)) }, + 'foo->bar(our($foo,$bar)) is not called in lvalue context'; + ok eval { main->bliggles(local($foo,$bar)) }, + 'foo->bar(local($foo,$bar)) is not called in lvalue context'; + ok eval { () = main->lbiggles(my($foo,$bar)); 1 }, + 'foo->lv(my($foo,$bar)) is not called in lvalue context'; + ok eval { () = main->lbiggles(our($foo,$bar)); 1 }, + 'foo->lv(our($foo,$bar)) is not called in lvalue context'; + ok eval { () = main->lbiggles(local($foo,$bar)); 1 }, + 'foo->lv(local($foo,$bar)) is not called in lvalue context'; +} -- Perl5 Master Repository
