This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [patch] GvSHARED
authorDoug MacEachern <dougm@covalent.net>
Sat, 10 Feb 2001 14:04:40 +0000 (06:04 -0800)
committerJarkko Hietaniemi <jhi@iki.fi>
Sun, 11 Feb 2001 06:30:23 +0000 (06:30 +0000)
Date: Sat, 10 Feb 2001 14:04:40 -0800 (PST)
Message-ID: <Pine.LNX.4.21.0102101356000.15298-100000@mako.covalent.net>

Subject: Re: [patch] GvSHARED
From: Doug MacEachern <dougm@covalent.net>
Date: Sat, 10 Feb 2001 15:00:54 -0800 (PST)
Message-ID: <Pine.LNX.4.21.0102101453220.15298-100000@mako.covalent.net>

Subject: [patch] attributes.pm support for `shared'
From: Doug MacEachern <dougm@covalent.net>
Date: Sat, 10 Feb 2001 20:08:48 -0800 (PST)
Message-ID: <Pine.LNX.4.21.0102102004190.15298-100000@mako.covalent.net>

our() attributes were ignored, our :shared pieces missing,
allow attributes.pm to turn on shared.

p4raw-id: //depot/perl@8766

op.c
t/op/attrs.t
toke.c
xsutils.c

diff --git a/op.c b/op.c
index 224cd61..366b183 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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 &&
index f9212e4..e8e11b3 100644 (file)
@@ -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}
 
diff --git a/toke.c b/toke.c
index dfa26f0..72e6f41 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -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)));
index b4161b0..187d9f7 100644 (file)
--- a/xsutils.c
+++ b/xsutils.c
@@ -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;