From: Rick Delaney <rick@consumercontact.com>
Date: Sun, 19 Jun 2005 09:47:22 +0000 (-0400)
Subject: Re: [PATCH replacement] Re: [perl #36313] perl -e "1for$[=0" crash
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dbfe47cffca44e11296e0f81e2a3b0d4458a8ba4;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH replacement] Re: [perl #36313] perl -e "1for$[=0" crash
Message-ID: <20050619134722.GB31592@localhost.localdomain>

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

diff --git a/op.c b/op.c
index 814b07d..b062678 100644
--- a/op.c
+++ b/op.c
@@ -3274,14 +3274,15 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	OP *curop;
 
 	PL_modcount = 0;
-	PL_eval_start = right;	/* Grandfathering $[ assignment here.  Bletch.*/
+	/* Grandfathering $[ assignment here.  Bletch.*/
+	/* Only simple assignments like C<< ($[) = 1 >> are allowed */
+	PL_eval_start = (left->op_type == OP_CONST) ? right : 0;
 	left = mod(left, OP_AASSIGN);
 	if (PL_eval_start)
 	    PL_eval_start = 0;
-	else {
-	    op_free(left);
-	    op_free(right);
-	    return Nullop;
+	else if (left->op_type == OP_CONST) {
+	    /* Result of assignment is always 1 (or we'd be dead already) */
+	    return newSVOP(OP_CONST, 0, newSViv(1));
 	}
 	/* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */
 	if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV)
@@ -3418,8 +3419,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	if (PL_eval_start)
 	    PL_eval_start = 0;
 	else {
-	    op_free(o);
-	    return Nullop;
+	    o = newSVOP(OP_CONST, 0, newSViv(PL_compiling.cop_arybase));
 	}
     }
     return o;
diff --git a/t/comp/parser.t b/t/comp/parser.t
index d784373..645e6e2 100644
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -9,7 +9,7 @@ BEGIN {
 }
 
 require "./test.pl";
-plan( tests => 47 );
+plan( tests => 54 );
 
 eval '%@x=0;';
 like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
@@ -168,3 +168,25 @@ EOF
     eval q{ sub _ __FILE__ {} };
     like($@, qr/Illegal declaration of subroutine main::_/, "__FILE__ as prototype");
 }
+
+# [perl #36313] perl -e "1for$[=0" crash
+{
+    my $x;
+    $x = 1 for ($[) = 0;
+    pass('optimized assignment to $[ used to segfault in list context');
+    if ($[ = 0) { $x = 1 }
+    pass('optimized assignment to $[ used to segfault in scalar context');
+    $x = ($[=2.4);
+    is($x, 2, 'scalar assignment to $[ behaves like other variables');
+    $x = (($[) = 0);
+    is($x, 1, 'list assignment to $[ behaves like other variables');
+    $x = eval q{ ($[, $x) = (0) };
+    like($@, qr/That use of \$\[ is unsupported/,
+             'cannot assign to $[ in a list');
+    eval q{ ($[) = (0, 1) };
+    like($@, qr/That use of \$\[ is unsupported/,
+             'cannot assign list of >1 elements to $[');
+    eval q{ ($[) = () };
+    like($@, qr/That use of \$\[ is unsupported/,
+             'cannot assign list of <1 elements to $[');
+}