This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #68108] : also fix if/else constant folding
authorFather Chrysostomos <sprout@cpan.org>
Fri, 7 Aug 2009 08:10:31 +0000 (10:10 +0200)
committerVincent Pit <perl@profvince.com>
Fri, 7 Aug 2009 08:12:02 +0000 (10:12 +0200)
op.c
t/op/do.t

diff --git a/op.c b/op.c
index 8574f52..a28e477 100644 (file)
--- 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);
index dd378cf..0fec534 100644 (file)
--- 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");
 }