Implement use attrs qw(locked package);

Passes all tests except posix (hangs/dies) in sigaction test after
printing "ok 9".

p4raw-id: //depot/ansiperl@901

diff --git a/cv.h b/cv.h
index 0eeedfd..b768f63 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -61,7 +61,8 @@ struct xpvcv {
 #define CVf_NODEBUG    0x0020  /* no DB::sub indirection for this CV
                                   (esp. useful for special XSUBs) */
 #define CVf_METHOD     0x0040  /* CV is explicitly marked as a method */
-#define CVf_LOCKED     0x0080  /* CV locks itself or first arg on entry */
+#define CVf_LOCKED     0x0080  /* CV locks itself, package or first arg on entry */
+#define CVf_PACKAGE    0x0100  /* CV locks package on entry */
 
 #define CvCLONE(cv)            (CvFLAGS(cv) & CVf_CLONE)
 #define CvCLONE_on(cv)         (CvFLAGS(cv) |= CVf_CLONE)
@@ -94,3 +95,8 @@ struct xpvcv {
 #define CvLOCKED(cv)           (CvFLAGS(cv) & CVf_LOCKED)
 #define CvLOCKED_on(cv)                (CvFLAGS(cv) |= CVf_LOCKED)
 #define CvLOCKED_off(cv)       (CvFLAGS(cv) &= ~CVf_LOCKED)
+
+#define CvPACKAGE(cv)          (CvFLAGS(cv) & CVf_PACKAGE)
+#define CvPACKAGE_on(cv)       (CvFLAGS(cv) |= CVf_PACKAGE)
+#define CvPACKAGE_off(cv)      (CvFLAGS(cv) &= ~CVf_PACKAGE)
+

diff --git a/ext/attrs/attrs.pm b/ext/attrs/attrs.pm
index fe2bf35..01a0de3 100644 (file)
--- a/ext/attrs/attrs.pm
+++ b/ext/attrs/attrs.pm
@@ -34,17 +34,27 @@ Valid attributes are as follows.
 
 Indicates that the invoking subroutine is a method.
 
+=item package
+
+If the subroutine is locked, lock the package in which it is
+defined.
+
 =item locked
 
 Setting this attribute is only meaningful when the subroutine or
-method is to be called by multiple threads. When set on a method
-subroutine (i.e. one marked with the B<method> attribute above),
-perl ensures that any invocation of it implicitly locks its first
-argument before execution. When set on a non-method subroutine,
-perl ensures that a lock is taken on the subroutine itself before
-execution. The semantics of the lock are exactly those of one
-explicitly taken with the C<lock> operator immediately after the
-subroutine is entered.
+method is to be called by multiple threads. When the B<package>
+attribute is set then before executing the subroutine or method
+perl acquires a lock on the package in which the subroutine is
+defined. 
+
+Otherwise, when set on a method subroutine (i.e. one
+marked with the B<method> attribute above), perl ensures that any
+invocation of it implicitly locks its first argument before
+execution. When set on a non-method subroutine,
+(without a B<package> attribute) perl ensures that a lock is taken 
+on the subroutine itself before execution. The semantics of the
+lock are exactly those of one explicitly taken with the C<lock> 
+operator immediately after the subroutine is entered.
 
 =back
 

diff --git a/ext/attrs/attrs.xs b/ext/attrs/attrs.xs
index dae612a..2de522a 100644 (file)
--- a/ext/attrs/attrs.xs
+++ b/ext/attrs/attrs.xs
@@ -9,6 +9,8 @@ get_flag(char *attr)
        return CVf_METHOD;
     else if (strnEQ(attr, "locked", 6))
        return CVf_LOCKED;
+    else if (strnEQ(attr, "package", 7))
+       return CVf_PACKAGE;
     else
        return 0;
 }
@@ -56,4 +58,6 @@ SV *  sub
            XPUSHs(sv_2mortal(newSVpv("method", 0)));
        if (CvFLAGS(sub) & CVf_LOCKED)
            XPUSHs(sv_2mortal(newSVpv("locked", 0)));
+       if (CvFLAGS(sub) & CVf_PACKAGE)
+           XPUSHs(sv_2mortal(newSVpv("package", 0)));
 

diff --git a/pp_hot.c b/pp_hot.c
index 0422605..41f2aee 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1923,8 +1923,11 @@ PP(pp_entersub)
      */
     MUTEX_LOCK(CvMUTEXP(cv));
     if (CvFLAGS(cv) & CVf_LOCKED) {
-       MAGIC *mg;      
-       if (CvFLAGS(cv) & CVf_METHOD) {
+       MAGIC *mg;        
+       if (CvFLAGS(cv) & CVf_PACKAGE) {
+           sv = (SV *) CvGV(cv);
+       }
+       else if (CvFLAGS(cv) & CVf_METHOD) {
            if (SP > stack_base + TOPMARK)
                sv = *(stack_base + TOPMARK + 1);
            else {