This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
constant folding shouldn't change return value of while [perl #73618]
authorJesse Luehrs <doy@tozt.net>
Tue, 3 Jul 2012 05:50:34 +0000 (00:50 -0500)
committerJesse Luehrs <doy@tozt.net>
Tue, 3 Jul 2012 05:58:46 +0000 (00:58 -0500)
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
t/op/loopctl.t

diff --git a/op.c b/op.c
index acc0e92..a831831 100644 (file)
--- 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 =
index 3a8fc9a..d28c191 100644 (file)
@@ -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");
+    }
+}