summaryrefslogtreecommitdiff
path: root/pp_ctl.c
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-07-09 19:18:45 -0700
committerFather Chrysostomos <sprout@cpan.org>2011-07-09 19:19:51 -0700
commit777d9014444bb88a98ccd6c09ebb520cdc4c0d8b (patch)
treeadd55b04929f0bc1462315c6aa167b4bfa2c641e /pp_ctl.c
parentfe57f3b7598666107c5e6e9c9ffd844da47ea527 (diff)
downloadperl-777d9014444bb88a98ccd6c09ebb520cdc4c0d8b.tar.gz
Propagate (non-)lvalue context through nested calls
Before this commit, this code would fail: $foo = "foo"; sub foo :lvalue{ return index "foo","o" } sub bar :lvalue { foo } $x = bar; (It would fail for ‘return $]’ as well. Whether it’s a PADTMP or a read-only scalar makes no difference.) foo would think it was being called in true lvalue context, because the entersub op that called it (in bar) was marked that way, bar being an lvalue sub as well. The PUSHSUB macro in cop.h needed to be modified to account for dynamic, or indetermine, context (i.e., indeterminable at compile time). This happens when an entersub op is an argument to return or the last statement in a subroutine. In those cases it has to propa- gate the context from the caller. So what we now do is this: Both lvalue and in-args flags are turned on for an entersub op when op_lvalue is called with OP_LEAVESUBLV as the type. Then PUSHSUB copies into the context stack only those flags that are set both on the current entersub op and in the context stack for the previous sub call.
Diffstat (limited to 'pp_ctl.c')
-rw-r--r--pp_ctl.c14
1 files changed, 14 insertions, 0 deletions
diff --git a/pp_ctl.c b/pp_ctl.c
index caa0da5038..854c89d607 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1469,6 +1469,20 @@ Perl_is_lvalue_sub(pTHX)
return 0;
}
+/* only used by PUSHSUB */
+I32
+Perl_was_lvalue_sub(pTHX)
+{
+ dVAR;
+ const I32 cxix = dopoptosub(cxstack_ix-1);
+ assert(cxix >= 0); /* We should only be called from inside subs */
+
+ if (CxLVAL(cxstack + cxix) && CvLVALUE(cxstack[cxix].blk_sub.cv))
+ return CxLVAL(cxstack + cxix);
+ else
+ return 0;
+}
+
STATIC I32
S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
{