mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

Re: perl 5.7.3 + XS lvalue subs

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

p4raw-id: //depot/perl@15565
This commit is contained in:
Spider Boardman 2002-03-27 15:52:28 -05:00 committed by Jarkko Hietaniemi
parent ccac678058
commit d3cea301eb
4 changed files with 23 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
cv.h
View File

@ -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)

4
op.c
View File

@ -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;

6
t/op/attrs.t
View File

@ -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
{

14
toke.c
View File

@ -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,