[perl.git] branch blead, updated. v5.15.7-108-g0865059

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 <sprout@cpan.org>
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

• [perl.git] branch blead, updated. v5.15.7-108-g0865059 by Father Chrysostomos