diff options
-rw-r--r-- | op.c | 10 | ||||
-rw-r--r-- | t/op/attrs.t | 5 | ||||
-rw-r--r-- | toke.c | 2 | ||||
-rw-r--r-- | xsutils.c | 22 |
4 files changed, 35 insertions, 4 deletions
@@ -1956,6 +1956,16 @@ S_my_kid(pTHX_ OP *o, OP *attrs) } else if (type == OP_RV2SV || /* "our" declaration */ type == OP_RV2AV || type == OP_RV2HV) { /* XXX does this let anything illegal in? */ + if (attrs) { + GV *gv = cGVOPx_gv(cUNOPo->op_first); + PL_in_my = FALSE; + PL_in_my_stash = Nullhv; + apply_attrs(GvSTASH(gv), + (type == OP_RV2SV ? GvSV(gv) : + type == OP_RV2AV ? (SV*)GvAV(gv) : + type == OP_RV2HV ? (SV*)GvHV(gv) : (SV*)gv), + attrs); + } o->op_private |= OPpOUR_INTRO; return o; } else if (type != OP_PADSV && diff --git a/t/op/attrs.t b/t/op/attrs.t index f9212e4c26..e8e11b3abf 100644 --- a/t/op/attrs.t +++ b/t/op/attrs.t @@ -150,11 +150,12 @@ sub X::MODIFY_CODE_ATTRIBUTES { die "$_[0]" } sub X::foo { 1 } *Y::bar = \&X::foo; *Y::bar = \&X::foo; # second time for -w -eval 'package Z; sub Y::bar : locked'; +eval 'package Z; sub Y::bar : foo'; mytest qr/^X at /; BEGIN {++$ntests} -my @attrs = eval 'attributes::get \&Y::bar'; +eval 'package Z; sub Y::baz : locked {}'; +my @attrs = eval 'attributes::get \&Y::baz'; mytest '', "@attrs", "locked"; BEGIN {++$ntests} @@ -3082,7 +3082,7 @@ Perl_yylex(pTHX) process, and shouldn't bother appending recognized flags. To experiment with that, uncomment the following "else": */ - /* else */ + else attrs = append_elem(OP_LIST, attrs, newSVOP(OP_CONST, 0, newSVpvn(s, len))); @@ -84,12 +84,30 @@ modify_SV_attributes(pTHXo_ SV *sv, SV **retlist, SV **attrlist, int numattrs) continue; } break; + case 's': + if (strEQ(name, "shared")) { + if (negated) + GvSHARED_off(CvGV((CV*)sv)); + else + GvSHARED_on(CvGV((CV*)sv)); + continue; + } + break; } break; } break; default: - /* nothing, yet */ + switch ((int)len) { + case 6: + switch (*name) { + case 's': + if (strEQ(name, "shared")) { + /* toke.c has already marked as GvSHARED */ + continue; + } + } + } break; } /* anything recognized had a 'continue' above */ @@ -168,6 +186,8 @@ usage: #endif if (cvflags & CVf_METHOD) XPUSHs(sv_2mortal(newSVpvn("method", 6))); + if (GvSHARED(CvGV((CV*)sv))) + XPUSHs(sv_2mortal(newSVpvn("shared", 6))); break; default: break; |