From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 4 Jun 2011 18:38:02 +0000 (-0700)
Subject: Allow lvalue subs to return COWs in reference context
X-Git-Tag: accepted/trunk/20130322.191538~3954
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=a130272381198bb249482fb77a994df28ddaf3bf;p=platform%2Fupstream%2Fperl.git

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..cd556f3f 100644
--- 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
--- 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