In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ef9da979fc5cddb4c5d039bc1c6205e98c09cc85?hp=c40e8e9bf43b15cbc5725b65e3085fba60a67489>
- Log ----------------------------------------------------------------- commit ef9da979fc5cddb4c5d039bc1c6205e98c09cc85 Author: Father Chrysostomos <[email protected]> Date: Fri Aug 7 10:10:31 2009 +0200 [perl #68108] : also fix if/else constant folding ----------------------------------------------------------------------- Summary of changes: op.c | 4 +++- t/op/do.t | 21 ++++++++++++++++++++- 2 files changed, 23 insertions(+), 2 deletions(-) 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"); } -- Perl5 Master Repository
