diff options
| -rw-r--r-- | pp_ctl.c | 7 | ||||
| -rw-r--r-- | t/op/sub_lval.t | 7 |
2 files changed, 9 insertions, 5 deletions
@@ -2252,6 +2252,7 @@ PP(pp_return) register PERL_CONTEXT *cx; bool popsub2 = FALSE; bool clear_errsv = FALSE; + bool lval = FALSE; I32 gimme; SV **newsp; PMOP *newpm; @@ -2292,6 +2293,7 @@ PP(pp_return) 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; @@ -2339,7 +2341,8 @@ PP(pp_return) } } else - *++newsp = (SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP); + *++newsp = + (lval || SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP); } else *++newsp = sv_mortalcopy(*SP); @@ -2349,7 +2352,7 @@ PP(pp_return) } 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 */ } diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t index bb2794c9a1..a2b3c2218a 100644 --- a/t/op/sub_lval.t +++ b/t/op/sub_lval.t @@ -500,10 +500,11 @@ is($@, "", "element of tied array"); 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 } |