In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/dd3e51dc8ab0e4da0f911ca693aa0ceaaf79318a?hp=d781deb6546425b0eb8ff14422b0c2fb4352a053>
- Log ----------------------------------------------------------------- commit dd3e51dc8ab0e4da0f911ca693aa0ceaaf79318a Author: Vincent Pit <[email protected]> Date: Tue Aug 4 16:13:28 2009 +0200 Promote blocks resulting from constant folding to first-class do { } blocks This solves [perl #68108]: no retval from sub { if(1){ ... } } ----------------------------------------------------------------------- Summary of changes: op.c | 2 ++ t/op/do.t | 22 +++++++++++++++++++++- 2 files changed, 23 insertions(+), 1 deletions(-) diff --git a/op.c b/op.c index d1ed080..8574f52 100644 --- a/op.c +++ b/op.c @@ -4552,6 +4552,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) return newop; } op_free(first); + if (other->op_type == OP_LEAVE) + other = newUNOP(OP_NULL, OPf_SPECIAL, other); return other; } else { diff --git a/t/op/do.t b/t/op/do.t index 43ce3e8..dd378cf 100644 --- a/t/op/do.t +++ b/t/op/do.t @@ -29,7 +29,7 @@ sub ok { return $ok; } -print "1..38\n"; +print "1..44\n"; # Test do &sub and proper @_ handling. $_[0] = 0; @@ -140,6 +140,26 @@ ok(defined $x && $x == 4, 'return do { do { ; } } receives caller scalar context @x = sub { do { return do { 1; do { 2; @a } } }; 5 }->(); ok("@x" eq "7 8 9 10", 'return do { do { ; } } receives caller list context'); +# Do blocks created by constant folding +# [perl #68108] +$x = sub { if (1) { 20 } }->(); +ok($x == 20, 'if (1) { $x } receives caller scalar context'); + +...@a = (21 .. 23); +$x = sub { if (1) { @a } }->(); +ok($x == 3, 'if (1) { @a } receives caller scalar context'); +...@x = sub { if (1) { @a } }->(); +ok("@x" eq "21 22 23", 'if (1) { @a } receives caller list context'); + +$x = sub { if (1) { 0; 20 } }->(); +ok($x == 20, 'if (1) { ...; $x } receives caller scalar context'); + +...@a = (24 .. 27); +$x = sub { if (1) { 0; @a } }->(); +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'); + END { 1 while unlink("$$.16", "$$.17", "$$.18"); } -- Perl5 Master Repository
