From 317f3b66defd784a4e8b4d817739351e8d7a24c2 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Tue, 3 Jul 2012 00:50:34 -0500
Subject: [PATCH] constant folding shouldn't change return value of while [perl
 #73618]

If the expression in while (EXPR) is a false constant, just return that
constant expression rather than OP_NULL during optimization.

Doesn't handle until loops yet, because "until (1)" is converted to
"while (!1)" by the parser, and so "!1" is already constant-folded to ''
by the time the while loop optree is constructed. Not sure what to do
about that.
---
 op.c           |  3 +--
 t/op/loopctl.t | 63 +++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 63 insertions(+), 3 deletions(-)

diff --git a/op.c b/op.c
index acc0e927abba..a831831bfc80 100644
--- a/op.c
+++ b/op.c
@@ -6279,9 +6279,8 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop,
 	scalar(listop);
 	o = new_logop(OP_AND, 0, &expr, &listop);
 	if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
-	    op_free(expr);		/* oops, it's a while (0) */
 	    op_free((OP*)loop);
-	    return NULL;		/* listop already freed by new_logop */
+	    return expr;		/* listop already freed by new_logop */
 	}
 	if (listop)
 	    ((LISTOP*)listop)->op_last->op_next =
diff --git a/t/op/loopctl.t b/t/op/loopctl.t
index 3a8fc9a9ba73..d28c1917555f 100644
--- a/t/op/loopctl.t
+++ b/t/op/loopctl.t
@@ -36,7 +36,7 @@ BEGIN {
 }
 
 require "test.pl";
-plan( tests => 55 );
+plan( tests => 61 );
 
 my $ok;
 
@@ -1006,3 +1006,64 @@ cmp_ok($ok,'==',1,'dynamically scoped');
     }
     ok(!$fail, "perl 112316: Labels with the same prefix don't get mixed up.");
 }
+
+# [perl #73618]
+{
+    sub foo_73618_0 {
+        while (0) { }
+    }
+    sub bar_73618_0 {
+        my $i = 0;
+        while ($i) { }
+    }
+    sub foo_73618_undef {
+        while (undef) { }
+    }
+    sub bar_73618_undef {
+        my $i = undef;
+        while ($i) { }
+    }
+    sub foo_73618_emptystring {
+        while ("") { }
+    }
+    sub bar_73618_emptystring {
+        my $i = "";
+        while ($i) { }
+    }
+    sub foo_73618_0float {
+        while (0.0) { }
+    }
+    sub bar_73618_0float {
+        my $i = 0.0;
+        while ($i) { }
+    }
+    sub foo_73618_0string {
+        while ("0") { }
+    }
+    sub bar_73618_0string {
+        my $i = "0";
+        while ($i) { }
+    }
+    sub foo_73618_until {
+        until (1) { }
+    }
+    sub bar_73618_until {
+        my $i = 1;
+        until ($i) { }
+    }
+
+    is(scalar(foo_73618_0()), scalar(bar_73618_0()),
+       "constant optimization doesn't change return value");
+    is(scalar(foo_73618_undef()), scalar(bar_73618_undef()),
+       "constant optimization doesn't change return value");
+    is(scalar(foo_73618_emptystring()), scalar(bar_73618_emptystring()),
+       "constant optimization doesn't change return value");
+    is(scalar(foo_73618_0float()), scalar(bar_73618_0float()),
+       "constant optimization doesn't change return value");
+    is(scalar(foo_73618_0string()), scalar(bar_73618_0string()),
+       "constant optimization doesn't change return value");
+    { local $TODO = "until is still wrongly optimized";
+    is(scalar(foo_73618_until()), scalar(bar_73618_until()),
+       "constant optimization doesn't change return value");
+    }
+}