From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Wed, 5 Jul 2006 20:00:10 +0000 (+0000)
Subject: Fix a bug on setting OPpASSIGN_COMMON on a AASSIGN op when the left
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f17e6c41cacfbc6fe88a5ea5e01ba690dfdc7f2e;p=p5sagit%2Fp5-mst-13.2.git

Fix a bug on setting OPpASSIGN_COMMON on a AASSIGN op when the left
side is made out a list declared with our(). In this case OPpLVAL_INTRO
isn't set on the left op, so we just remove that check. Add new tests.

p4raw-id: //depot/perl@28488
---

diff --git a/op.c b/op.c
index d2c6835..dd7a5f2 100644
--- a/op.c
+++ b/op.c
@@ -3783,7 +3783,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	 * to store these values, evil chicanery is done with SvCUR().
 	 */
 
-	if (!(left->op_private & OPpLVAL_INTRO)) {
 	    OP *lastop = o;
 	    PL_generation++;
 	    for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
@@ -3837,7 +3836,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	    }
 	    if (curop != o)
 		o->op_private |= OPpASSIGN_COMMON;
-	}
 	if (right && right->op_type == OP_SPLIT) {
 	    OP* tmpop = ((LISTOP*)right)->op_first;
 	    if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
diff --git a/t/op/array.t b/t/op/array.t
index 3a6a792..74539a8 100755
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -7,7 +7,7 @@ BEGIN {
 
 require 'test.pl';
 
-plan (117);
+plan (125);
 
 #
 # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
@@ -176,7 +176,6 @@ is("@bar", "foo bar");						# 43
 
 # try the same with my
 {
-
     my @bee = @bee;
     is("@bee", "foo bar burbl blah");				# 54
     {
@@ -202,6 +201,29 @@ is("@bar", "foo bar");						# 43
     is("@bee", "foo bar burbl blah");				# 63
 }
 
+# try the same with our (except that previous values aren't restored)
+{
+    our @bee = @bee;
+    is("@bee", "foo bar burbl blah");
+    {
+	our (undef,@bee) = @bee;
+	is("@bee", "bar burbl blah");
+	{
+	    our @bee = ('XXX',@bee,'YYY');
+	    is("@bee", "XXX bar burbl blah YYY");
+	    {
+		our @bee = our @bee = qw(foo bar burbl blah);
+		is("@bee", "foo bar burbl blah");
+		{
+		    our (@bim) = our(@bee) = qw(foo bar);
+		    is("@bee", "foo bar");
+		    is("@bim", "foo bar");
+		}
+	    }
+	}
+    }
+}
+
 # make sure reification behaves
 my $t = curr_test();
 sub reify { $_[1] = $t++; print "@_\n"; }
@@ -384,4 +406,18 @@ sub test_arylen {
     is ($4[8], 23);
 }
 
+# more tests for AASSIGN_COMMON
+
+{
+    our($x,$y,$z) = (1..3);
+    our($y,$z) = ($x,$y);
+    is("$x $y $z", "1 1 2");
+}
+{
+    our($x,$y,$z) = (1..3);
+    (our $y, our $z) = ($x,$y);
+    is("$x $y $z", "1 1 2");
+}
+
+
 "We're included by lib/Tie/Array/std.t so we need to return something true";