From: Doug MacEachern <dougm@covalent.net>
Date: Sat, 10 Feb 2001 14:04:40 +0000 (-0800)
Subject: Re: [patch] GvSHARED
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0256094b4c2296e320dfc83acdb944c28ae745d0;hp=be24517c7d6dbd51b4477cded03d9c0853e614ee;p=p5sagit%2Fp5-mst-13.2.git

Re: [patch] GvSHARED
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
---

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