[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 (file)
--- 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 (file)
--- 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 }