register PERL_CONTEXT *cx;
bool popsub2 = FALSE;
bool clear_errsv = FALSE;
+ bool lval = FALSE;
I32 gimme;
SV **newsp;
PMOP *newpm;
switch (CxTYPE(cx)) {
case CXt_SUB:
popsub2 = TRUE;
+ lval = !!CvLVALUE(cx->blk_sub.cv);
retop = cx->blk_sub.retop;
cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
break;
}
}
else
- *++newsp = (SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP);
+ *++newsp =
+ (lval || SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP);
}
else
*++newsp = sv_mortalcopy(*SP);
}
else if (gimme == G_ARRAY) {
while (++MARK <= SP) {
- *++newsp = (popsub2 && SvTEMP(*MARK))
+ *++newsp = popsub2 && (lval || SvTEMP(*MARK))
? *MARK : sv_mortalcopy(*MARK);
TAINT_NOT; /* Each item is independent */
}
is ($Tie_Array::val[0], "value");
-TODO: {
- local $TODO = 'test explicit return of lval expr';
- # subs are corrupted copies from tests 1-~18
+# Test explicit return of lvalue expression
+{
+ # subs are copies from tests 1-~18 with an explicit return added.
+ # They used not to work, which is why they are ‘badly’ named.
sub bad_get_lex : lvalue { return $in };
sub bad_get_st : lvalue { return $blah }