Re: perl 5.7.3 + XS lvalue subs

   Message-Id: <200203290552.AAA47443@leggy.zk3.dec.com>

p4raw-id: //depot/perl@15592

diff --git a/op.c b/op.c
index 98d42da..9b07a2f 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4899,6 +4899,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
         */
        if (cv && !block) {
            rcv = (SV*)cv;
+           /* Might have had built-in attributes applied -- propagate them. */
+           CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
            if (CvGV(cv) && GvSTASH(CvGV(cv)))
                stash = GvSTASH(CvGV(cv));
            else if (CvSTASH(cv))

diff --git a/t/op/attrs.t b/t/op/attrs.t
index 8e04936..1ed92a1 100644 (file)
--- a/t/op/attrs.t
+++ b/t/op/attrs.t
@@ -180,6 +180,14 @@ eval 'package A; sub X { $_[0] } sub X : lvalue';
 mytest '', "@attrs", "lvalue";
 BEGIN {++$ntests}
 
+# Above not with just 'pure' built-in attributes.
+sub Z::MODIFY_CODE_ATTRIBUTES { (); }
+eval 'package Z; sub L { $_[0] } sub L : Z lvalue';
+@attrs = eval 'attributes::get \&Z::L';
+mytest '', "@attrs", "lvalue Z";
+BEGIN {++$ntests}
+
+
 # Begin testing attributes that tie
 
 {