This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
skip trying to constant fold an incomplete op tree
authorTony Cook <tony@develop-help.com>
Tue, 8 Dec 2020 03:28:29 +0000 (14:28 +1100)
committerTony Cook <tony@develop-help.com>
Wed, 23 Dec 2020 02:42:48 +0000 (02:42 +0000)
This code would try to constant fold an op tree like

  relop
    +- null
    +- constant

which would underflow the stack, potentially crashing perl.

This is intended as a quick fix rather than as a complete
solution.

Fixes #18380

op.c
t/op/cmpchain.t

diff --git a/op.c b/op.c
index 822ea18..b2e12dd 100644 (file)
--- a/op.c
+++ b/op.c
@@ -5591,7 +5591,7 @@ Perl_cmpchain_finish(pTHX_ OP *ch)
            cmpop->op_private = 2;
            cmpop = CHECKOP(cmpoptype, cmpop);
            if(!cmpop->op_next && cmpop->op_type == cmpoptype)
            cmpop->op_private = 2;
            cmpop = CHECKOP(cmpoptype, cmpop);
            if(!cmpop->op_next && cmpop->op_type == cmpoptype)
-               cmpop = fold_constants(op_integerize(op_std_init(cmpop)));
+               cmpop = op_integerize(op_std_init(cmpop));
            condop = condop ? newLOGOP(OP_CMPCHAIN_AND, 0, cmpop, condop) :
                        cmpop;
            if (!nextrightarg)
            condop = condop ? newLOGOP(OP_CMPCHAIN_AND, 0, cmpop, condop) :
                        cmpop;
            if (!nextrightarg)
index 92a2f41..236d5f9 100644 (file)
@@ -14,13 +14,6 @@ my @nceqop = qw(<=> cmp ~~);
 my @chrelop = qw(< > <= >= lt gt le ge);
 my @ncrelop = qw(isa);
 
 my @chrelop = qw(< > <= >= lt gt le ge);
 my @ncrelop = qw(isa);
 
-plan tests => @nceqop*@nceqop + 2*@cheqop*@nceqop + 2*@cheqop*@cheqop*@nceqop +
-       @ncrelop*@ncrelop + 2*@chrelop*@ncrelop + 2*@chrelop*@chrelop*@ncrelop +
-
-       @cheqop*@cheqop + @chrelop*@chrelop +
-       @cheqop*@cheqop*@cheqop + @chrelop*@chrelop*@chrelop +
-       (9 + 6*9)*13;
-
 foreach my $c0 (@nceqop) {
     foreach my $c1 (@nceqop) {
        is eval("sub { \$a $c0 \$b $c1 \$c }"), undef,
 foreach my $c0 (@nceqop) {
     foreach my $c1 (@nceqop) {
        is eval("sub { \$a $c0 \$b $c1 \$c }"), undef,
@@ -168,3 +161,13 @@ foreach(
            "operand evaluation order";
     }
 }
            "operand evaluation order";
     }
 }
+
+# https://github.com/Perl/perl5/issues/18380
+fresh_perl_is(<<'CODE', "", {}, "stack underflow");
+no warnings "uninitialized";
+my $v;
+1 < $v < 2;
+2 < $v < 3;
+CODE
+
+done_testing();