diff options
| -rw-r--r-- | op.c | 2 | ||||
| -rw-r--r-- | t/op/do.t | 22 |
2 files changed, 23 insertions, 1 deletions
@@ -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 { @@ -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"); } |