From 145b2bbb325a2181db2f44a0d0576e39e61b2e8b Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 31 May 2011 18:13:43 -0700
Subject: [PATCH] Allow rvalue syntax in expr returned from lvalue sub
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

This changes the syntax of the last statement and the arguments to
‘return’ in an lvalue subroutine to be the same as that of a non-
lvalue routine. This almost finishes the work begun by commit fa1e92c.
(return still needs to enforce the same rules as leavesublv.)
---
 op.c            |  3 ++-
 t/op/sub_lval.t | 51 ++++++++++++++++++++++++++++++++-------------------
 2 files changed, 34 insertions(+), 20 deletions(-)

diff --git a/op.c b/op.c
index e1bf353..c493a5f 100644
--- a/op.c
+++ b/op.c
@@ -1569,7 +1569,8 @@ Perl_op_lvalue(pTHX_ OP *o, I32 type)
     default:
       nomod:
 	/* grep, foreach, subcalls, refgen */
-	if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
+	if (type == OP_GREPSTART || type == OP_ENTERSUB
+	 || type == OP_REFGEN    || type == OP_LEAVESUBLV)
 	    break;
 	yyerror(Perl_form(aTHX_ "Can't modify %s in %s",
 		     (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index 818dc60..787d904 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=>100;
+plan tests=>107;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -260,16 +260,12 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify index in lvalue subroutine return/);
+like($_, qr/Can\'t return a temporary from lvalue subroutine/);
 
 $_ = undef;
-eval <<'EOE' or $_ = $@;
-  sub lv2t : lvalue { shift }
-  (lv2t) = (2,3);
-  1;
-EOE
-
-like($_, qr/Can\'t modify shift in lvalue subroutine return/);
+sub lv2t : lvalue { shift }
+(lv2t($_)) = (2,3);
+is($_, 2);
 
 $xxx = 'xxx';
 sub xxx () { $xxx }  # Not lvalue
@@ -281,7 +277,7 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call in lvalue subroutine return/);
+is($_, undef, "returning a temp from an lvalue sub in scalar context");
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -291,14 +287,6 @@ EOE
 
 is($_, undef, "returning a temp from an lvalue sub in list context");
 
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  lv1tmp = 3;
-  1;
-EOE
-
-is($_, undef, "returning a temp from an lvalue sub in scalar context");
-
 sub yyy () { 'yyy' } # Const, not lvalue
 
 $_ = undef;
@@ -308,7 +296,7 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify constant item in lvalue subroutine return/);
+like($_, qr/Can\'t return a readonly value from lvalue subroutine at/);
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -667,3 +655,28 @@ 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';
+
+
+# Returning an arbitrary expression, not necessarily lvalue
++sub :lvalue { return $ambaga || $ambaga }->() = 73;
+is $ambaga, 73, 'explicit return of arbitrary expression (scalar context)';
+(sub :lvalue { return $ambaga || $ambaga }->()) = 74;
+is $ambaga, 74, 'explicit return of arbitrary expression (list context)';
++sub :lvalue { $ambaga || $ambaga }->() = 73;
+is $ambaga, 73, 'implicit return of arbitrary expression (scalar context)';
+(sub :lvalue { $ambaga || $ambaga }->()) = 74;
+is $ambaga, 74, 'implicit return of arbitrary expression (list context)';
+{ local $::TODO = 'return needs to enforce the same rules as leavesublv';
+eval { +sub :lvalue { return 3 }->() = 4 };
+like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
+      'assignment to numeric constant explicitly returned from lv sub';
+eval { (sub :lvalue { return 3 }->()) = 4 };
+like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
+      'assignment to num constant explicitly returned (list cx)';
+}
+eval { +sub :lvalue { 3 }->() = 4 };
+like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
+      'assignment to numeric constant implicitly returned from lv sub';
+eval { (sub :lvalue { 3 }->()) = 4 };
+like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
+      'assignment to num constant implicitly returned (list cx)';
-- 
2.7.4