From: Father Chrysostomos <sprout@cpan.org>
Date: Fri, 27 May 2011 13:26:10 +0000 (-0700)
Subject: [perl #72724] explicit return doesn’t work with lvalue subs
X-Git-Tag: accepted/trunk/20130322.191538~4036
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=fa1e92c44be6a2be80c5ca0ecc8a04bc172c3497;p=platform%2Fupstream%2Fperl.git

[perl #72724] explicit return doesn’t work with lvalue subs

Now it does.
---

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 }