From fa1e92c44be6a2be80c5ca0ecc8a04bc172c3497 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Fri, 27 May 2011 06:26:10 -0700 Subject: [PATCH] =?utf8?q?[perl=20#72724]=20explicit=20return=20doesn?= =?utf8?q?=E2=80=99t=20work=20with=20lvalue=20subs?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Now it does. --- pp_ctl.c | 7 +++++-- t/op/sub_lval.t | 7 ++++--- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index f86f55c..9ce16c1 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -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 bb2794c..a2b3c22 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 } -- 2.7.4