From ba2940cef5817468ce021916ff709a8ba665e2eb Mon Sep 17 00:00:00 2001 From: "Jerry D. Hedden" Date: Tue, 19 Dec 2006 02:30:47 -0800 Subject: [PATCH] threads::shared 1.06 From: "Jerry D. Hedden" Message-ID: <525867.40748.qm@web30207.mail.mud.yahoo.com> p4raw-id: //depot/perl@29599 --- ext/threads/shared/Changes | 8 +++++-- ext/threads/shared/README | 2 +- ext/threads/shared/shared.pm | 8 +++---- ext/threads/shared/shared.xs | 52 ++++++++++++++++---------------------------- ext/threads/shared/t/cond.t | 31 +++++++++++++------------- 5 files changed, 45 insertions(+), 56 deletions(-) diff --git a/ext/threads/shared/Changes b/ext/threads/shared/Changes index 006232f..0241bc1 100644 --- 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 --- 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 --- 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 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 Discussion Forum on CPAN: L Annotated POD for L: -L +L L, L diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs index 88d1e5c..dcc2c97 100644 --- 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 --- 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 $_"); } -- 2.7.4