From bdd419192a8b2ab26be9cf5b4b8d7fe6f66b144c Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 8 Dec 2020 14:28:29 +1100
Subject: 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

(cherry picked from commit 08be3ef7f1190d94279ad0b3e13519ac8dc3b0ec)
---
 op.c            |  2 +-
 t/op/cmpchain.t | 17 ++++++++++-------
 2 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/op.c b/op.c
index 65001cd44a..dae04f932e 100644
--- a/op.c
+++ b/op.c
@@ -5605,7 +5605,7 @@ Perl_cmpchain_finish(pTHX_ OP *ch)
 	    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)
diff --git a/t/op/cmpchain.t b/t/op/cmpchain.t
index 92a2f4133d..236d5f9a83 100644
--- 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);
 
-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,
@@ -168,3 +161,13 @@ foreach(
 	    "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();
-- 
cgit v1.2.1