From: Gurusamy Sarathy Date: Sun, 10 Oct 1999 03:37:21 +0000 (+0000) Subject: fix two leaks in Thread.xs (from Eugene Alterman X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0655b981bb492c08abff4ec3ef984eda8c2af724;p=p5sagit%2Fp5-mst-13.2.git fix two leaks in Thread.xs (from Eugene Alterman ); convert places with 'use attrs' to new attributes syntax p4raw-id: //depot/perl@4328 --- diff --git a/ext/Thread/Thread.pm b/ext/Thread/Thread.pm index 1dacdc0..7956a79 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 a sub, using C. Any calls to that sub from another thread will block until the lock is released. This behaviour is not -equvalent to C in the sub. C -serializes access to a subroutine, but allows different threads +equivalent to declaring the sub with the C attribute. The C +attribute serializes access to a subroutine, but allows different threads non-simultaneous access. C, on the other hand, will not allow I 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, L, L, L. +L, L, L, L. =cut diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index a57f477..6cc1081 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 6d5f82b..6e2fba8 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 915808c..f50f96c 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 46b9b60..da3f937 100644 --- a/ext/Thread/Thread/Specific.pm +++ b/ext/Thread/Thread/Specific.pm @@ -15,14 +15,12 @@ C 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 9c2e589..6445b55 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 0901da4..ffc74b4 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;