Re: [PATCH replacement] Re: [perl #36313] perl -e "1for$[=0" crash

[Rick Delaney]

On Sun, Jun 19, 2005 at 11:34:55AM -0000, Piotr Fusik wrote:
> + $x = 1 for $[ = 0;
> + pass('optimized assignment to $[ used to segfault in scalar context');
> + if (($[) = 0) { $x = 1 }
> + pass('optimized assignment to $[ used to segfault in list context');
> 
> Looks like the descriptions of contexts are swapped (i.e. "for" should be
> "list", "if" should be "scalar").

No, the first assignment is in scalar context and the second (with
parentheses) is in list context.  But the results of the assignments are
taken in list and scalar contexts, respectively, which I suppose is a
little confusing.  I just took the two test cases presented and
arbitrarily made one of them list context.  Here's the whole thing again
with the arbitrariness going the other way.

-- 
Rick Delaney
[EMAIL PROTECTED]


diff -ruN perl-current/op.c perl-current-dev/op.c
--- perl-current/op.c   2005-06-16 06:15:46.000000000 -0400
+++ perl-current-dev/op.c       2005-06-17 22:00:03.000000000 -0400
@@ -3274,14 +3274,15 @@
        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 @@
        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 -ruN perl-current/t/comp/parser.t perl-current-dev/t/comp/parser.t
--- perl-current/t/comp/parser.t        2004-06-24 12:47:01.000000000 -0400
+++ perl-current-dev/t/comp/parser.t    2005-06-19 09:41:00.392743456 -0400
@@ -9,7 +9,7 @@
 }
 
 require "./test.pl";
-plan( tests => 47 );
+plan( tests => 54 );
 
 eval '[EMAIL PROTECTED];';
 like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '[EMAIL 
PROTECTED]' );
@@ -168,3 +168,25 @@
     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 $[');
+}