Re: perl 5.7.3 + XS lvalue subs

Message-Id: <200203280152.UAA415562@leggy.zk3.dec.com>

p4raw-id: //depot/perl@15565

4 files changed, 23 insertions, 3 deletions

diff --git a/cv.h b/cv.h
index 824517c199..ccbfa4358b 100644
--- a/cv.h
+++ b/cv.h
@@ -85,6 +85,8 @@ Returns the stash of the CV.
 #define CVf_LOCKED	0x0080	/* CV locks itself or first arg on entry */
 #define CVf_LVALUE	0x0100  /* CV return value can be used as lvalue */
 #define CVf_CONST	0x0200  /* inlinable sub */
+/* This symbol for optimised communication between toke.c and op.c: */
+#define CVf_BUILTIN_ATTRS	(CVf_METHOD|CVf_LOCKED|CVf_LVALUE)
 
 #define CvCLONE(cv)		(CvFLAGS(cv) & CVf_CLONE)
 #define CvCLONE_on(cv)		(CvFLAGS(cv) |= CVf_CLONE)
diff --git a/op.c b/op.c
index 82c9b0290e..98d42daf0e 100644
--- a/op.c
+++ b/op.c
@@ -4842,6 +4842,10 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	/* already defined (or promised)? */
 	if (exists || GvASSUMECV(gv)) {
 	    if (!block && !attrs) {
+		if (CvFLAGS(PL_compcv)) {
+		    /* might have had built-in attrs applied */
+		    CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
+		}
 		/* just a "sub foo;" when &foo is already defined */
 		SAVEFREESV(PL_compcv);
 		goto done;
diff --git a/t/op/attrs.t b/t/op/attrs.t
index 611fb66638..8e04936f8d 100644
--- a/t/op/attrs.t
+++ b/t/op/attrs.t
@@ -174,6 +174,12 @@ BEGIN {++$ntests}
 mytest '', "@attrs", "locked method Z";
 BEGIN {++$ntests}
 
+# Test ability to modify existing sub's (or XSUB's) attributes.
+eval 'package A; sub X { $_[0] } sub X : lvalue';
+@attrs = eval 'attributes::get \&A::X';
+mytest '', "@attrs", "lvalue";
+BEGIN {++$ntests}
+
 # Begin testing attributes that tie
 
 {
diff --git a/toke.c b/toke.c
index 87c94c1cf3..85ec1d1be5 100644
--- a/toke.c
+++ b/toke.c
@@ -2990,6 +2990,8 @@ Perl_yylex(pTHX)
 		    PL_lex_stuff = Nullsv;
 		}
 		else {
+		    /* NOTE: any CV attrs applied here need to be part of
+		       the CVf_BUILTIN_ATTRS define in cv.h! */
 		    if (!PL_in_my && len == 6 && strnEQ(s, "lvalue", len))
 			CvLVALUE_on(PL_compcv);
 		    else if (!PL_in_my && len == 6 && strnEQ(s, "locked", len))
@@ -2997,14 +2999,20 @@ Perl_yylex(pTHX)
 		    else if (!PL_in_my && len == 6 && strnEQ(s, "method", len))
 			CvMETHOD_on(PL_compcv);
 #ifdef USE_ITHREADS
-      else if (PL_in_my == KEY_our && len == 6 && strnEQ(s, "unique", len))
+		    else if (PL_in_my == KEY_our && len == 6 &&
+			     strnEQ(s, "unique", len))
 			GvUNIQUE_on(cGVOPx_gv(yylval.opval));
 #endif
 		    /* After we've set the flags, it could be argued that
 		       we don't need to do the attributes.pm-based setting
 		       process, and shouldn't bother appending recognized
-		       flags. To experiment with that, uncomment the
-		       following "else": */
+		       flags.  To experiment with that, uncomment the
+		       following "else".  (Note that's already been
+		       uncommented.  That keeps the above-applied built-in
+		       attributes from being intercepted (and possibly
+		       rejected) by a package's attribute routines, but is
+		       justified by the performance win for the common case
+		       of applying only built-in attributes.) */
 		    else
 		        attrs = append_elem(OP_LIST, attrs,
 					    newSVOP(OP_CONST, 0,