skip trying to constant fold an incomplete op tree

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

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)

diff --git a/t/op/cmpchain.t b/t/op/cmpchain.t
index 92a2f41..236d5f9 100644 (file)
--- a/t/op/cmpchain.t
+++ b/t/op/cmpchain.t
@@ -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();