Change 34907 by [EMAIL PROTECTED] on 2008/11/25 06:28:40
Subject: [perl #38809] return do { } : take 3 (or 4...)
From: Vincent Pit <[EMAIL PROTECTED]>
Date: Mon, 29 Sep 2008 17:36:09 +0200
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/op.c#1024 edit
... //depot/perl/op.h#215 edit
... //depot/perl/pp_hot.c#593 edit
... //depot/perl/t/op/do.t#20 edit
Differences ...
==== //depot/perl/op.c#1024 (text) ====
Index: perl/op.c
--- perl/op.c#1023~34905~ 2008-11-24 19:51:41.000000000 -0800
+++ perl/op.c 2008-11-24 22:28:40.000000000 -0800
@@ -7644,14 +7644,28 @@
Perl_ck_return(pTHX_ OP *o)
{
dVAR;
+ OP *kid;
PERL_ARGS_ASSERT_CK_RETURN;
+ kid = cLISTOPo->op_first->op_sibling;
if (CvLVALUE(PL_compcv)) {
- OP *kid;
- for (kid = cLISTOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
+ for (; kid; kid = kid->op_sibling)
mod(kid, OP_LEAVESUBLV);
+ } else {
+ for (; kid; kid = kid->op_sibling)
+ if ((kid->op_type == OP_NULL)
+ && (kid->op_flags & OPf_SPECIAL)) {
+ /* This is a do block */
+ OP *op = cUNOPx(kid)->op_first;
+ assert(op && (op->op_type == OP_LEAVE) && (op->op_flags &
OPf_KIDS));
+ op = cUNOPx(op)->op_first;
+ assert(op->op_type == OP_ENTER && !(op->op_flags &
OPf_SPECIAL));
+ /* Force the use of the caller's context */
+ op->op_flags |= OPf_SPECIAL;
+ }
}
+
return o;
}
==== //depot/perl/op.h#215 (text) ====
Index: perl/op.h
--- perl/op.h#214~34819~ 2008-11-12 02:37:46.000000000 -0800
+++ perl/op.h 2008-11-24 22:28:40.000000000 -0800
@@ -137,6 +137,7 @@
/* On OP_SMARTMATCH, an implicit smartmatch */
/* On OP_ANONHASH and OP_ANONLIST, create a
reference to the new anon hash or array */
+ /* On OP_ENTER, store caller context */
/* On OP_HELEM and OP_HSLICE, localization
will be followed
by assignment, so do not wipe the target if
it is special
(e.g. a glob or a magic SV) */
==== //depot/perl/pp_hot.c#593 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#592~34833~ 2008-11-14 06:29:53.000000000 -0800
+++ perl/pp_hot.c 2008-11-24 22:28:40.000000000 -0800
@@ -1754,9 +1754,13 @@
I32 gimme = OP_GIMME(PL_op, -1);
if (gimme == -1) {
- if (cxstack_ix >= 0)
- gimme = cxstack[cxstack_ix].blk_gimme;
- else
+ if (cxstack_ix >= 0) {
+ /* If this flag is set, we're just inside a return, so we should
+ * store the caller's context */
+ gimme = (PL_op->op_flags & OPf_SPECIAL)
+ ? block_gimme()
+ : cxstack[cxstack_ix].blk_gimme;
+ } else
gimme = G_SCALAR;
}
@@ -1865,13 +1869,7 @@
POPBLOCK(cx,newpm);
- gimme = OP_GIMME(PL_op, -1);
- if (gimme == -1) {
- if (cxstack_ix >= 0)
- gimme = cxstack[cxstack_ix].blk_gimme;
- else
- gimme = G_SCALAR;
- }
+ gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
TAINT_NOT;
if (gimme == G_VOID)
==== //depot/perl/t/op/do.t#20 (xtext) ====
Index: perl/t/op/do.t
--- perl/t/op/do.t#19~34310~ 2008-09-07 14:32:44.000000000 -0700
+++ perl/t/op/do.t 2008-11-24 22:28:40.000000000 -0800
@@ -29,7 +29,7 @@
return $ok;
}
-print "1..26\n";
+print "1..32\n";
# Test do &sub and proper @_ handling.
$_[0] = 0;
@@ -104,6 +104,23 @@
$owww = do { 4 if not $zok };
ok( $owww eq '', 'last is if not' );
+# [perl #38809]
[EMAIL PROTECTED] = (7, 8);
+$x = sub { do { return do { 1; @a } }; 3 }->();
+ok(defined $x && $x == 2, 'return do { } receives caller scalar context');
[EMAIL PROTECTED] = sub { do { return do { 1; @a } }; 3 }->();
+ok("@x" eq "7 8", 'return do { } receives caller list context');
[EMAIL PROTECTED] = (7, 8, 9);
+$x = sub { do { do { 1; return @a } }; 4 }->();
+ok(defined $x && $x == 3, 'do { return } receives caller scalar context');
[EMAIL PROTECTED] = sub { do { do { 1; return @a } }; 4 }->();
+ok("@x" eq "7 8 9", 'do { return } receives caller list context');
[EMAIL PROTECTED] = (7, 8, 9, 10);
+$x = sub { do { return do { 1; do { 2; @a } } }; 5 }->();
+ok(defined $x && $x == 4, 'return do { do { } } receives caller scalar
context');
[EMAIL PROTECTED] = sub { do { return do { 1; do { 2; @a } } }; 5 }->();
+ok("@x" eq "7 8 9 10", 'return do { do { } } receives caller list context');
+
END {
1 while unlink("$$.16", "$$.17", "$$.18");
}
End of Patch.
