Allow ‘sub x :lvalue’ to apply to XSUBs and stubs

This was disabled in 5.12 (with a warning) by commit 885ef6f5, because
applying the attribute to a Perl sub isn’t effective: it does not mod-
ify the op tree accordingly.

But applying an attribute to an XSUB after the fact is perfectly
fine, and is the only way to do it (either with declarative syntax or
attributes.pm).  This commit restores the old behaviour of declarative
for XSUBs.  (attributes.pm never stopped working.)

Commit 885ef6f5 also stopped a declaration from applying the flag to
an undefined subroutine if it happens to have been assigned from else-
where.  It does not make sense to allow the :method attribute to be
applied to such a sub, but not :lvalue.

3 files changed, 23 insertions, 3 deletions

diff --git a/op.c b/op.c
index bd403abca9..8792a2fac3 100644
--- a/op.c
+++ b/op.c
@@ -6217,9 +6217,13 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		 )&& !attrs) {
 		if (CvFLAGS(PL_compcv)) {
 		    /* might have had built-in attrs applied */
-		    if (CvLVALUE(PL_compcv) && ! CvLVALUE(cv) && ckWARN(WARN_MISC))
+		    const bool pureperl = !CvISXSUB(cv) && CvROOT(cv);
+		    if (CvLVALUE(PL_compcv) && ! CvLVALUE(cv) && pureperl
+		     && ckWARN(WARN_MISC))
 			Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined");
-		    CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS & ~CVf_LVALUE);
+		    CvFLAGS(cv) |=
+			(CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS
+			  & ~(CVf_LVALUE * pureperl));
 		}
 		/* just a "sub foo;" when &foo is already defined */
 		SAVEFREESV(PL_compcv);
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index e2e35ae5ca..fadb4c437b 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -1088,6 +1088,12 @@ would not return C<$]>, but a copy of it.
 Assignment to C<keys> returned from an lvalue sub used not to work, but now
 it does.
 
+=item *
+
+Applying the C<:lvalue> attribute to an XSUB or to an aliased subroutine
+stub with C<< sub foo :lvalue; >> syntax stopped working in Perl 5.12.
+This has been fixed.
+
 =back
 
 =head2 Fixes related to hashes
diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index e4518ffbc9..dff060420e 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=>158;
+plan tests=>160;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -710,6 +710,16 @@ Execution of - aborted due to compilation errors.
     is($x, 5, "subroutine declared with lvalue before definition retains lvalue. [perl #68758]");
 }
 
+sub utf8::valid :lvalue;
+require attributes;
+is "@{[ &attributes::get(\&utf8::valid) ]}", 'lvalue',
+   'sub declaration with :lvalue applies it to XSUBs';
+
+BEGIN { *wonky = \&marjibberous }
+sub wonky :lvalue;
+is "@{[ &attributes::get(\&wonky) ]}", 'lvalue',
+   'sub declaration with :lvalue applies it to assigned stub';
+
 sub fleen : lvalue { $pnare }
 $pnare = __PACKAGE__;
 ok eval { fleen = 1 }, "lvalues can return COWs (CATTLE?) [perl #75656]";\