From: Gerard Goossen <gerard@ggoossen.net>
Date: Sat, 13 Aug 2011 16:38:13 +0000 (+0200)
Subject: Propagate lvalue context only to children of list ops which are not in void context.
X-Git-Tag: accepted/trunk/20130322.191538~3145^2~5
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=5c906035ffb6b2857a0f941a97ac9e7bb4126275;p=platform%2Fupstream%2Fperl.git

Propagate lvalue context only to children of list ops which are not in void context.

Children list ops might be in void context because the list is in scalar
context. A test that discarded elements in a list are not assigned lvalue
context is added.
Children of a list op might also be in void context because they are
special entersub ops for attributes. This patch makes the
OPpENTERSUB_NOMOD flag redundant.
---

diff --git a/op.c b/op.c
index 775705b..c4c0e76 100644
--- a/op.c
+++ b/op.c
@@ -1718,6 +1718,8 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 	return o;
     }
 
+    assert( (o->op_flags & OPf_WANT) != OPf_WANT_VOID );
+
     switch (o->op_type) {
     case OP_UNDEF:
 	localize = 0;
@@ -2016,7 +2018,10 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
     case OP_LIST:
 	localize = 0;
 	for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
-	    op_lvalue(kid, type);
+	    /* elements might be in void context because the list is
+	       in scalar context or because they are attribute sub calls */
+	    if ( (kid->op_flags & OPf_WANT) != OPf_WANT_VOID )
+		op_lvalue(kid, type);
 	break;
 
     case OP_RETURN:
diff --git a/t/op/list.t b/t/op/list.t
index c6a0a9a..87045fc 100644
--- a/t/op/list.t
+++ b/t/op/list.t
@@ -6,7 +6,7 @@ BEGIN {
 }
 
 require "test.pl";
-plan( tests => 63 );
+plan( tests => 64 );
 
 @foo = (1, 2, 3, 4);
 cmp_ok($foo[0], '==', 1, 'first elem');
@@ -175,3 +175,10 @@ cmp_ok(join('',(1,2),3,(4,5)),'eq','12345','list (..).(..)');
     my @b = qw();
     is($#b, -1);
 }
+
+{
+    # comma operator with lvalue only propagates the lvalue context to
+    # the last operand.
+    ("const", my $x) ||= 1;
+    is( $x, 1 );
+}