Integrate with Sarathy.

p4raw-id: //depot/cfgperl@4334

7 files changed, 21 insertions, 27 deletions

diff --git a/ext/Thread/Thread.pm b/ext/Thread/Thread.pm
index 1dacdc0482..7956a7984f 100644
--- a/ext/Thread/Thread.pm
+++ b/ext/Thread/Thread.pm
@@ -77,8 +77,8 @@ of that container are not locked. For example, if a thread does a C<lock
 
 You may also C<lock> a sub, using C<lock &sub>. Any calls to that sub from
 another thread will block until the lock is released. This behaviour is not
-equvalent to C<use attrs qw(locked)> in the sub. C<use attrs qw(locked)>
-serializes access to a subroutine, but allows different threads
+equivalent to declaring the sub with the C<locked> attribute.  The C<locked>
+attribute serializes access to a subroutine, but allows different threads
 non-simultaneous access. C<lock &sub>, on the other hand, will not allow
 I<any> other thread access for the duration of the lock.
 
@@ -185,7 +185,7 @@ duplicate tids. This limitation may be lifted in a future version of Perl.
 
 =head1 SEE ALSO
 
-L<attrs>, L<Thread::Queue>, L<Thread::Semaphore>, L<Thread::Specific>.
+L<attributes>, L<Thread::Queue>, L<Thread::Semaphore>, L<Thread::Specific>.
 
 =cut
 
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index a57f4770b2..6cc1081c40 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -31,6 +31,7 @@ remove_thread(pTHX_ struct perl_thread *t)
     PL_nthreads--;
     t->prev->next = t->next;
     t->next->prev = t->prev;
+    SvREFCNT_dec(t->oursv);
     COND_BROADCAST(&PL_nthreads_cond);
     MUTEX_UNLOCK(&PL_threads_mutex);
 #endif
@@ -136,7 +137,8 @@ threadstart(void *arg)
 	av_store(av, 1, newSVsv(thr->errsv));
 	DEBUG_S(PerlIO_printf(Perl_debug_log, "%p died: %s\n",
 			      thr, SvPV(thr->errsv, PL_na)));
-    } else {
+    }
+    else {
 	DEBUG_S(STMT_START {
 	    for (i = 1; i <= retval; i++) {
 		PerlIO_printf(Perl_debug_log, "%p return[%d] = %s\n",
@@ -298,7 +300,6 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname)
 	/* Thread creation failed--clean up */
 	SvREFCNT_dec(thr->cvcache);
 	remove_thread(aTHX_ thr);
-	MUTEX_DESTROY(&thr->mutex);
 	for (i = 0; i <= AvFILL(initargs); i++)
 	    SvREFCNT_dec(*av_fetch(initargs, i, FALSE));
 	SvREFCNT_dec(startsv);
@@ -385,11 +386,14 @@ join(t)
 	}
 	JOIN(t, &av);
 
+	sv_2mortal((SV*)av);
+
 	if (SvTRUE(*av_fetch(av, 0, FALSE))) {
 	    /* Could easily speed up the following if necessary */
 	    for (i = 1; i <= AvFILL(av); i++)
-		XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
-	} else {
+		XPUSHs(*av_fetch(av, i, FALSE));
+	}
+	else {
 	    STRLEN n_a;
 	    char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a);
 	    DEBUG_S(PerlIO_printf(Perl_debug_log,
diff --git a/ext/Thread/Thread/Queue.pm b/ext/Thread/Thread/Queue.pm
index 6d5f82be34..6e2fba8e88 100644
--- a/ext/Thread/Thread/Queue.pm
+++ b/ext/Thread/Thread/Queue.pm
@@ -67,15 +67,13 @@ sub new {
     return bless [@_], $class;
 }
 
-sub dequeue {
-    use attrs qw(locked method);
+sub dequeue : locked, method {
     my $q = shift;
     cond_wait $q until @$q;
     return shift @$q;
 }
 
-sub dequeue_nb {
-  use attrs qw(locked method);
+sub dequeue_nb : locked, method {
   my $q = shift;
   if (@$q) {
     return shift @$q;
@@ -84,14 +82,12 @@ sub dequeue_nb {
   }
 }
 
-sub enqueue {
-    use attrs qw(locked method);
+sub enqueue : locked, method {
     my $q = shift;
     push(@$q, @_) and cond_broadcast $q;
 }
 
-sub pending {
-  use attrs qw(locked method);
+sub pending : locked, method {
   my $q = shift;
   return scalar(@$q);
 }
diff --git a/ext/Thread/Thread/Semaphore.pm b/ext/Thread/Thread/Semaphore.pm
index 915808cbed..f50f96c8af 100644
--- a/ext/Thread/Thread/Semaphore.pm
+++ b/ext/Thread/Thread/Semaphore.pm
@@ -69,16 +69,14 @@ sub new {
     bless \$val, $class;
 }
 
-sub down {
-    use attrs qw(locked method);
+sub down : locked, method {
     my $s = shift;
     my $inc = @_ ? shift : 1;
     cond_wait $s until $$s >= $inc;
     $$s -= $inc;
 }
 
-sub up {
-    use attrs qw(locked method);
+sub up : locked, method {
     my $s = shift;
     my $inc = @_ ? shift : 1;
     ($$s += $inc) > 0 and cond_broadcast $s;
diff --git a/ext/Thread/Thread/Specific.pm b/ext/Thread/Thread/Specific.pm
index 46b9b60981..da3f9375a7 100644
--- a/ext/Thread/Thread/Specific.pm
+++ b/ext/Thread/Thread/Specific.pm
@@ -15,14 +15,12 @@ C<key_create> returns a unique thread-specific key.
 
 =cut
 
-sub import {
-    use attrs qw(locked method);
+sub import : locked, method {
     require fields;
     fields::->import(@_);
 }	
 
-sub key_create {
-    use attrs qw(locked method);
+sub key_create : locked, method {
     return ++$FIELDS{__MAX__};
 }
 
diff --git a/ext/Thread/sync.t b/ext/Thread/sync.t
index 9c2e5897da..6445b5579c 100644
--- a/ext/Thread/sync.t
+++ b/ext/Thread/sync.t
@@ -2,8 +2,7 @@ use Thread;
 
 $level = 0;
 
-sub single_file {
-    use attrs 'locked';
+sub single_file : locked {
     my $arg = shift;
     $level++;
     print "Level $level for $arg\n";
diff --git a/ext/Thread/sync2.t b/ext/Thread/sync2.t
index 0901da46a0..ffc74b4ec1 100644
--- a/ext/Thread/sync2.t
+++ b/ext/Thread/sync2.t
@@ -2,8 +2,7 @@ use Thread;
 
 $global = undef;
 
-sub single_file {
-    use attrs 'locked';
+sub single_file : locked {
     my $who = shift;
     my $i;