Make empty lvalue subs work correctly

In perl 5.8.1 and earlier, sub{} would return @_ in list context. This
was fixed in 5.8.2 for regular subs, but not lvalue subs.

Before the syntactic restriction on return values was removed in
commit 145b2bb, there was a bug affecting compilation of empty subs
before any use statement:

$ perl5.14.0 -e 'sub foo :lvalue {}'
Can't modify stub in lvalue subroutine return at -e line 1, near "{}"
Execution of -e aborted due to compilation errors.
$ perl5.14.0 -le 'use sigtrap; sub foo :lvalue {} print "ok"'
ok

But I digress. :-)

Up to 5.14, lvalue subs were still returning @_, or, rather, the ele-
ments of @_ as separate scalars:

$ perl5.14.0 -Mre -le '(sub :lvalue {}->($a,$b))=(3,4); print "$a $b"'
Useless use of "re" pragma at -e line 0
3 4

(Not exactly useless, eh? The -Mre allows the sub to compile.)

This commit fixes that bug.

3 files changed, 25 insertions, 16 deletions

diff --git a/op.c b/op.c
index c493a5f826..71452d6f0f 100644
--- a/op.c
+++ b/op.c
@@ -6368,14 +6368,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        exit.  */
        
     PL_breakable_sub_gen++;
-    if (CvLVALUE(cv)) {
-	CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
-			     op_lvalue(scalarseq(block), OP_LEAVESUBLV));
-	block->op_attached = 1;
-    }
-    else {
-	/* This makes sub {}; work as expected.  */
-	if (block->op_type == OP_STUB) {
+    /* This makes sub {}; work as expected.  */
+    if (block->op_type == OP_STUB) {
 	    OP* const newblock = newSTATEOP(0, NULL, 0);
 #ifdef PERL_MAD
 	    op_getmad(block,newblock,'B');
@@ -6383,11 +6377,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    op_free(block);
 #endif
 	    block = newblock;
-	}
-	else
-	    block->op_attached = 1;
-	CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
     }
+    else block->op_attached = 1;
+    CvROOT(cv) = CvLVALUE(cv)
+		   ? newUNOP(OP_LEAVESUBLV, 0,
+			     op_lvalue(scalarseq(block), OP_LEAVESUBLV))
+		   : newUNOP(OP_LEAVESUB, 0, scalarseq(block));
     CvROOT(cv)->op_private |= OPpREFCOUNTED;
     OpREFCNT_set(CvROOT(cv), 1);
     CvSTART(cv) = LINKLIST(CvROOT(cv));
diff --git a/pp_hot.c b/pp_hot.c
index 2525a26d39..bb0f20517b 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2745,14 +2745,22 @@ PP(pp_leavesublv)
 		    SvREFCNT_inc_void(*mark);
 		}
 	    }
-	    else {			/* Should not happen? */
+	    else {
+		/* sub:lvalue{} will take us here.
+		   Presumably the case of a non-empty array never happens.
+		 */
 		LEAVE;
 		cxstack_ix--;
 		POPSUB(cx,sv);
 		PL_curpm = newpm;
 		LEAVESUB(sv);
-		DIE(aTHX_ "%s returned from lvalue subroutine in scalar context",
-		    (MARK > SP ? "Empty array" : "Array"));
+		DIE(aTHX_ "%s",
+		    (MARK > SP
+		      ? "Can't return undef from lvalue subroutine"
+		      : "Array returned from lvalue subroutine in scalar "
+		        "context"
+		    )
+		);
 	    }
 	    SP = MARK;
 	}
diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index 787d904c4f..c1691cb336 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=>107;
+plan tests=>108;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -230,6 +230,12 @@ EOE
 
 ok(!defined $_) or diag $_;
 
+($a,$b)=();
+(lv0($a,$b)) = (3,4);
+is +($a//'undef') . ($b//'undef'), 'undefundef',
+   'list assignment to empty lvalue sub';
+
+
 sub lv1u :lvalue { undef }
 
 $_ = undef;