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

[Rick Delaney]

On Fri, Jun 17, 2005 at 12:00:07AM +0100, [EMAIL PROTECTED] wrote:
> Rafael Garcia-Suarez <[EMAIL PROTECTED]> wrote:
> :
> :Note that other kinds of similar code segfaults too :
> :
> :$ perl -e 'if($[=0){print}'
> :Segmentation fault
> :
> :I'd rather solve all those cases once and for all.
> 
> It sounds like the bug is in the optimiser: if it acts on C< $[ = 0 >
> at compile time, it should substitute the resulting value (C< 0 >),
> and leave it to other optimisations to refine that further if it is
> in void context, or leads to a constant conditional.

This patch should do that.  It also fixes this:

    % perl -wle '($_, $[) = (42);print "$_:$["'
    Use of uninitialized value in concatenation (.) or string at -e line 1.
    :42

by disallowing it.  It now gives:

    That use of $[ is unsupported at -e line 1.

-- 
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-17 22:02:54.074228248 -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 scalar context');
+    if (($[) = 0) { $x = 1 }
+    pass('optimized assignment to $[ used to segfault in list 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{ ($[, $x) = (0, 1) };
+    like($@, qr/That use of \$\[ is unsupported/,
+             'cannot assign list of >1 elements to $[');
+    eval q{ ($[, $x) = () };
+    like($@, qr/That use of \$\[ is unsupported/,
+             'cannot assign list of <1 elements to $[');
+}