threads::shared 1.06

From: "Jerry D. Hedden" <jdhedden@yahoo.com>
Message-ID: <525867.40748.qm@web30207.mail.mud.yahoo.com>

p4raw-id: //depot/perl@29599

diff --git a/ext/threads/shared/Changes b/ext/threads/shared/Changes
index 006232f..0241bc1 100644 (file)
--- a/ext/threads/shared/Changes
+++ b/ext/threads/shared/Changes
@@ -1,10 +1,14 @@
 Revision history for Perl extension threads::shared.
 
-1.05 Wed Oct 25 14:22:23 EDT 2006
+1.06 Tue Dec 19 13:26:46 EST 2006
+       - Fixed a bug in unlocking code
+       - Added stress test for cond_* functions
+
+1.05 Wed Oct 25 14:27:36 EDT 2006
        - Makefile.PL changes for CORE
        - g++ build fixes
 
-1.04 Thu Oct 12 10:40:18 EDT 2006
+1.04 Thu Oct 12 10:50:46 EDT 2006
        - Added example script
        - Added POD tests
 

diff --git a/ext/threads/shared/README b/ext/threads/shared/README
index e5aead4..db884f3 100644 (file)
--- a/ext/threads/shared/README
+++ b/ext/threads/shared/README
@@ -1,4 +1,4 @@
-threads::shared version 1.05
+threads::shared version 1.06
 ============================
 
 This module needs Perl 5.8.0 or later compiled with USEITHREADS.

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index d4a0eeb..414033a 100644 (file)
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '1.05';
+our $VERSION = '1.06';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -73,7 +73,7 @@ threads::shared - Perl extension for sharing data structures between threads
 
 =head1 VERSION
 
-This document describes threads::shared version 1.05
+This document describes threads::shared version 1.06
 
 =head1 SYNOPSIS
 
@@ -262,7 +262,7 @@ signaling before another thread has entered cond_wait().
 
 C<cond_signal> will normally generate a warning if you attempt to use it on an
 unlocked variable. On the rare occasions where doing this may be sensible, you
-can skip the warning with:
+can suppress the warning with:
 
   { no warnings 'threads'; cond_signal($foo); }
 
@@ -368,7 +368,7 @@ L<threads::shared> Discussion Forum on CPAN:
 L<http://www.cpanforum.com/dist/threads-shared>
 
 Annotated POD for L<threads::shared>:
-L<http://annocpan.org/~JDHEDDEN/threads-shared-1.05/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.06/shared.pm>
 
 L<threads>, L<perlthrtut>
 

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index 88d1e5c..dcc2c97 100644 (file)
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -205,11 +205,11 @@ void
 recursive_lock_release(pTHX_ recursive_lock_t *lock)
 {
     MUTEX_LOCK(&lock->mutex);
-    if (lock->owner != aTHX) {
-        MUTEX_UNLOCK(&lock->mutex);
-    } else if (--lock->locks == 0) {
-        lock->owner = NULL;
-        COND_SIGNAL(&lock->cond);
+    if (lock->owner == aTHX) {
+        if (--lock->locks == 0) {
+            lock->owner = NULL;
+            COND_SIGNAL(&lock->cond);
+        }
     }
     MUTEX_UNLOCK(&lock->mutex);
 }
@@ -370,13 +370,9 @@ S_get_userlock(pTHX_ SV* ssv, bool create)
 }
 
 
-=for apidoc sharedsv_find
-
-Given a private side SV tries to find if the SV has a shared backend,
-by looking for the magic.
-
-=cut
-
+/* Given a private side SV tries to find if the SV has a shared backend,
+ * by looking for the magic.
+ */
 SV *
 Perl_sharedsv_find(pTHX_ SV *sv)
 {
@@ -1044,11 +1040,8 @@ MGVTBL sharedsv_array_vtbl = {
 #endif
 };
 
-=for apidoc sharedsv_unlock
-
-Recursively unlocks a shared sv.
 
-=cut
+/* Recursively unlocks a shared sv. */
 
 void
 Perl_sharedsv_unlock(pTHX_ SV *ssv)
@@ -1058,13 +1051,10 @@ Perl_sharedsv_unlock(pTHX_ SV *ssv)
     recursive_lock_release(aTHX_ &ul->lock);
 }
 
-=for apidoc sharedsv_lock
-
-Recursive locks on a sharedsv.
-Locks are dynamically scoped at the level of the first lock.
-
-=cut
 
+/* Recursive locks on a sharedsv.
+ * Locks are dynamically scoped at the level of the first lock.
+ */
 void
 Perl_sharedsv_lock(pTHX_ SV *ssv)
 {
@@ -1090,13 +1080,8 @@ Perl_sharedsv_locksv(pTHX_ SV *sv)
     Perl_sharedsv_lock(aTHX_ ssv);
 }
 
-=head1 Shared SV Functions
-
-=for apidoc sharedsv_init
 
-Saves a space for keeping SVs wider than an interpreter.
-
-=cut
+/* Saves a space for keeping SVs wider than an interpreter. */
 
 void
 Perl_sharedsv_init(pTHX)
@@ -1367,17 +1352,18 @@ cond_wait(SV *ref_cond, SV *ref_lock = 0)
         }
         if (ul->lock.owner != aTHX)
             croak("You need a lock before you can cond_wait");
+
         /* Stealing the members of the lock object worries me - NI-S */
         MUTEX_LOCK(&ul->lock.mutex);
         ul->lock.owner = NULL;
         locks = ul->lock.locks;
         ul->lock.locks = 0;
 
-        /* Since we are releasing the lock here we need to tell other
-         * people that is ok to go ahead and use it */
+        /* Since we are releasing the lock here, we need to tell other
+         * people that it is ok to go ahead and use it */
         COND_SIGNAL(&ul->lock.cond);
         COND_WAIT(user_condition, &ul->lock.mutex);
-        while(ul->lock.owner != NULL) {
+        while (ul->lock.owner != NULL) {
             /* OK -- must reacquire the lock */
             COND_WAIT(&ul->lock.cond, &ul->lock.mutex);
         }
@@ -1423,8 +1409,8 @@ cond_timedwait(SV *ref_cond, double abs, SV *ref_lock = 0)
         ul->lock.owner = NULL;
         locks = ul->lock.locks;
         ul->lock.locks = 0;
-        /* Since we are releasing the lock here we need to tell other
-         * people that is ok to go ahead and use it */
+        /* Since we are releasing the lock here, we need to tell other
+         * people that it is ok to go ahead and use it */
         COND_SIGNAL(&ul->lock.cond);
         RETVAL = Perl_sharedsv_cond_timedwait(user_condition, &ul->lock.mutex, abs);
         while (ul->lock.owner != NULL) {

diff --git a/ext/threads/shared/t/cond.t b/ext/threads/shared/t/cond.t
index 71ac219..08b2d30 100644 (file)
--- a/ext/threads/shared/t/cond.t
+++ b/ext/threads/shared/t/cond.t
@@ -292,25 +292,24 @@ $Base++;
 
     my @threads;
     for (1..$cnt) {
-        my $thread = threads->create(sub {
-                        my $arg = $_;
-                        my $result = 0;
-                        for (0..1000000) {
-                            $result++;
-                        }
-                        lock($mutex);
-                        while ($mutex != $_) {
-                            cond_wait($mutex);
-                        }
-                        $mutex++;
-                        cond_broadcast($mutex);
-                        return $result;
-                      });
-        push(@threads, $thread);
+        $threads[$_] = threads->create(sub {
+                            my $arg = shift;
+                            my $result = 0;
+                            for (0..1000000) {
+                                $result++;
+                            }
+                            lock($mutex);
+                            while ($mutex != $arg) {
+                                cond_wait($mutex);
+                            }
+                            $mutex++;
+                            cond_broadcast($mutex);
+                            return $result;
+                      }, $_);
     }
 
     for (1..$cnt) {
-        my $result = $threads[$_-1]->join();
+        my $result = $threads[$_]->join();
         ok($_, defined($result) && ("$result" eq '1000001'), "stress test - iter $_");
     }