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,