Allow lvalue subs to return COWs in reference context

(That’s ‘reference’ as in ‘pass by reference’. It applies to
foo(lvalue_func()) and for(lvalue_func()).)

Commit f71f472 took care of scalar context.
Commit a0aa607 came and long and took care of list context, but,
unfortunately, missed reference context.

This commit takes care of that.

diff --git a/pp_hot.c b/pp_hot.c
index 34c493b..cd556f3 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2697,7 +2697,9 @@ PP(pp_leavesublv)
            for (mark = newsp + 1; mark <= SP; mark++) {
                if (SvTEMP(*mark))
                    NOOP;
-               else if (SvFLAGS(*mark) & (SVs_PADTMP | SVf_READONLY))
+               else if (SvFLAGS(*mark) & SVs_PADTMP
+                     || (SvFLAGS(*mark) & (SVf_READONLY|SVf_FAKE))
+                          == SVf_READONLY)
                    *mark = sv_mortalcopy(*mark);
                else {
                    /* Can be a localized value subject to deletion. */

diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index db9806b..a149a38 100644 (file)
--- a/t/op/sub_lval.t
+++ b/t/op/sub_lval.t
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
 }
-plan tests=>149;
+plan tests=>151;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -712,6 +712,9 @@ is $pnare, 1, 'and returning CATTLE actually works';
 $pnare = __PACKAGE__;
 ok eval { (fleen) = 1 }, "lvalues can return COWs in list context";
 is $pnare, 1, 'and returning COWs in list context actually works';
+$pnare = __PACKAGE__;
+ok eval { $_ = 1 for(fleen); 1 }, "lvalues can return COWs in ref cx";
+is $pnare, 1, 'and returning COWs in reference context actually works';
 
 
 # Returning an arbitrary expression, not necessarily lvalue