From: Father Chrysostomos <sprout@cpan.org>
Date: Fri, 7 Aug 2009 08:10:31 +0000 (+0200)
Subject: [perl #68108] : also fix if/else constant folding
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ef9da979fc5cddb4c5d039bc1c6205e98c09cc85;p=p5sagit%2Fp5-mst-13.2.git

[perl #68108] : also fix if/else constant folding
---

diff --git a/op.c b/op.c
index 8574f52..a28e477 100644
--- a/op.c
+++ b/op.c
@@ -57,7 +57,7 @@ context is, either upward in the syntax tree, or either forward or
 backward in the execution order.  (The bottom-up parser builds that
 part of the execution order it knows about, but if you follow the "next"
 links around, you'll find it's actually a closed loop through the
-top level node.
+top level node.)
 
 Whenever the bottom-up parser gets to a node that supplies context to
 its components, it invokes that portion of the top-down pass that applies
@@ -4691,6 +4691,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
 	    op_free(first);
 	    op_free(dead);
 	}
+	if (live->op_type == OP_LEAVE)
+	    live = newUNOP(OP_NULL, OPf_SPECIAL, live);
 	return live;
     }
     NewOp(1101, logop, 1, LOGOP);
diff --git a/t/op/do.t b/t/op/do.t
index dd378cf..0fec534 100644
--- a/t/op/do.t
+++ b/t/op/do.t
@@ -29,7 +29,7 @@ sub ok {
     return $ok;
 }
 
-print "1..44\n";
+print "1..50\n";
 
 # Test do &sub and proper @_ handling.
 $_[0] = 0;
@@ -160,6 +160,25 @@ ok($x == 4, 'if (1) { ...; @a } receives caller scalar context');
 @x = sub { if (1) { 0; @a } }->();
 ok("@x" eq "24 25 26 27", 'if (1) { ...; @a } receives caller list context');
 
+$x = sub { if (1) { 0; 20 } else{} }->();
+ok($x == 20, 'if (1) { ...; $x } else{} receives caller scalar context');
+
+@a = (24 .. 27);
+$x = sub { if (1) { 0; @a } else{} }->();
+ok($x == 4, 'if (1) { ...; @a } else{} receives caller scalar context');
+@x = sub { if (1) { 0; @a } else{} }->();
+ok("@x" eq "24 25 26 27", 'if (1) { ...; @a } else{} receives caller list context');
+
+$x = sub { if (0){} else { 0; 20 } }->();
+ok($x == 20, 'if (0){} else { ...; $x } receives caller scalar context');
+
+@a = (24 .. 27);
+$x = sub { if (0){} else { 0; @a } }->();
+ok($x == 4, 'if (0){} else { ...; @a } receives caller scalar context');
+@x = sub { if (0){} else { 0; @a } }->();
+ok("@x" eq "24 25 26 27", 'if (0){} else { ...; @a } receives caller list context');
+
+
 END {
     1 while unlink("$$.16", "$$.17", "$$.18");
 }