From: Jerry D. Hedden Date: Wed, 15 Nov 2006 11:36:58 +0000 (-0800) Subject: threads 1.51 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=adc09a0e5b2b0588d0a62db3176ffdfc7657b8ac;p=p5sagit%2Fp5-mst-13.2.git threads 1.51 From: "Jerry D. Hedden" Message-ID: <71793.95536.qm@web30213.mail.mud.yahoo.com> p4raw-id: //depot/perl@29293 --- diff --git a/ext/threads/Changes b/ext/threads/Changes index f29126f..a2b2d39 100755 --- a/ext/threads/Changes +++ b/ext/threads/Changes @@ -1,5 +1,8 @@ Revision history for Perl extension threads. +1.51 Wed Nov 15 14:25:30 EST 2006 + - Thread destruction fix + 1.49 Fri Nov 3 08:33:28 EST 2006 - Fix a warning message diff --git a/ext/threads/README b/ext/threads/README index effd009..1751704 100755 --- a/ext/threads/README +++ b/ext/threads/README @@ -1,4 +1,4 @@ -threads version 1.49 +threads version 1.51 ==================== This module exposes interpreter threads to the Perl level. diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t index 8eb54c0..6c3043b 100644 --- a/ext/threads/t/exit.t +++ b/ext/threads/t/exit.t @@ -56,7 +56,7 @@ my $rc = $thr->join(); ok(! defined($rc), 'Exited: threads->exit()'); -run_perl(prog => 'use threads 1.49;' . +run_perl(prog => 'use threads 1.51;' . 'threads->exit(86);' . 'exit(99);', nolib => ($ENV{PERL_CORE}) ? 0 : 1, @@ -104,7 +104,7 @@ $rc = $thr->join(); ok(! defined($rc), 'Exited: $thr->set_thread_exit_only'); -run_perl(prog => 'use threads 1.49 qw(exit thread_only);' . +run_perl(prog => 'use threads 1.51 qw(exit thread_only);' . 'threads->create(sub { exit(99); })->join();' . 'exit(86);', nolib => ($ENV{PERL_CORE}) ? 0 : 1, @@ -112,7 +112,7 @@ run_perl(prog => 'use threads 1.49 qw(exit thread_only);' . is($?>>8, 86, "'use threads 'exit' => 'thread_only'"); -my $out = run_perl(prog => 'use threads 1.49;' . +my $out = run_perl(prog => 'use threads 1.51;' . 'threads->create(sub {' . ' exit(99);' . '})->join();' . @@ -124,7 +124,7 @@ is($?>>8, 99, "exit(status) in thread"); like($out, '1 finished and unjoined', "exit(status) in thread"); -$out = run_perl(prog => 'use threads 1.49 qw(exit thread_only);' . +$out = run_perl(prog => 'use threads 1.51 qw(exit thread_only);' . 'threads->create(sub {' . ' threads->set_thread_exit_only(0);' . ' exit(99);' . @@ -137,7 +137,7 @@ is($?>>8, 99, "set_thread_exit_only(0)"); like($out, '1 finished and unjoined', "set_thread_exit_only(0)"); -run_perl(prog => 'use threads 1.49;' . +run_perl(prog => 'use threads 1.51;' . 'threads->create(sub {' . ' $SIG{__WARN__} = sub { exit(99); };' . ' die();' . diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t index c4be8fe..b3b716f 100644 --- a/ext/threads/t/thread.t +++ b/ext/threads/t/thread.t @@ -171,7 +171,7 @@ package main; # bugid #24165 -run_perl(prog => 'use threads 1.49;' . +run_perl(prog => 'use threads 1.51;' . 'sub a{threads->create(shift)} $t = a sub{};' . '$t->tid; $t->join; $t->tid', nolib => ($ENV{PERL_CORE}) ? 0 : 1, diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm index 32d592f..303d035 100755 --- a/ext/threads/threads.pm +++ b/ext/threads/threads.pm @@ -5,7 +5,7 @@ use 5.008; use strict; use warnings; -our $VERSION = '1.49'; +our $VERSION = '1.51'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -133,7 +133,7 @@ threads - Perl interpreter-based threads =head1 VERSION -This document describes threads version 1.49 +This document describes threads version 1.51 =head1 SYNOPSIS @@ -938,7 +938,7 @@ L Discussion Forum on CPAN: L Annotated POD for L: -L +L L, L diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index 2002619..3a1ea14 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -45,11 +45,12 @@ typedef perl_os_thread pthread_t; #endif /* Values for 'state' member */ -#define PERL_ITHR_JOINABLE 0 #define PERL_ITHR_DETACHED 1 #define PERL_ITHR_JOINED 2 #define PERL_ITHR_FINISHED 4 #define PERL_ITHR_THREAD_EXIT_ONLY 8 +#define PERL_ITHR_NONVIABLE 16 +#define PERL_ITHR_DESTROYED 32 typedef struct _ithread { struct _ithread *next; /* Next thread in the list */ @@ -133,8 +134,10 @@ S_ithread_clear(pTHX_ ithread *thread) { PerlInterpreter *interp; - assert((thread->state & PERL_ITHR_FINISHED) && - (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))); + assert(((thread->state & PERL_ITHR_FINISHED) && + (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) + || + (thread->state & PERL_ITHR_NONVIABLE)); interp = thread->interp; if (interp) { @@ -159,28 +162,40 @@ S_ithread_clear(pTHX_ ithread *thread) STATIC void S_ithread_destruct(pTHX_ ithread *thread) { - dMY_POOL; - + int destroy = 0; #ifdef WIN32 HANDLE handle; #endif - /* Return if thread is still being used */ + dMY_POOL; + + /* Determine if thread can be destroyed now */ + MUTEX_LOCK(&thread->mutex); if (thread->count != 0) { - return; + destroy = 0; + } else if (thread->state & PERL_ITHR_DESTROYED) { + destroy = 0; + } else if (thread->state & PERL_ITHR_NONVIABLE) { + thread->state |= PERL_ITHR_DESTROYED; + destroy = 1; + } else if (! (thread->state & PERL_ITHR_FINISHED)) { + destroy = 0; + } else if (! (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) { + destroy = 0; + } else { + thread->state |= PERL_ITHR_DESTROYED; + destroy = 1; } + MUTEX_UNLOCK(&thread->mutex); + if (! destroy) return; /* Main thread (0) is immortal and should never get here */ assert(thread->tid != 0); /* Remove from circular list of threads */ MUTEX_LOCK(&MY_POOL.create_destruct_mutex); - if ((! thread->next || ! thread->prev) && ckWARN_d(WARN_INTERNAL)) { - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "Inconsistency in internal threads list found " - "during destruction of thread %" UVuf, thread->tid); - } - if (thread->next) thread->next->prev = thread->prev; - if (thread->prev) thread->prev->next = thread->next; + assert(thread->prev && thread->next); + thread->next->prev = thread->prev; + thread->prev->next = thread->next; thread->next = NULL; thread->prev = NULL; MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); @@ -214,9 +229,8 @@ S_ithread_destruct(pTHX_ ithread *thread) STATIC int S_exit_warning(pTHX) { - dMY_POOL; - int veto_cleanup; + dMY_POOL; MUTEX_LOCK(&MY_POOL.create_destruct_mutex); veto_cleanup = (MY_POOL.running_threads || MY_POOL.joinable_threads); @@ -261,17 +275,14 @@ int ithread_mg_free(pTHX_ SV *sv, MAGIC *mg) { ithread *thread = (ithread *)mg->mg_ptr; - int cleanup; MUTEX_LOCK(&thread->mutex); - cleanup = ((--thread->count == 0) && - (thread->state & PERL_ITHR_FINISHED) && - (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))); + thread->count--; MUTEX_UNLOCK(&thread->mutex); - if (cleanup) { - S_ithread_destruct(aTHX_ thread); - } + /* Try to clean up thread */ + S_ithread_destruct(aTHX_ thread); + return (0); } @@ -372,7 +383,6 @@ S_ithread_run(void * arg) I32 oldscope; int exit_app = 0; int exit_code = 0; - int cleanup; dJMPENV; @@ -465,17 +475,15 @@ S_ithread_run(void * arg) if (thread->state & PERL_ITHR_THREAD_EXIT_ONLY) { exit_app = 0; } - /* Cleanup if detached */ - cleanup = (thread->state & PERL_ITHR_DETACHED); - MUTEX_UNLOCK(&thread->mutex); /* Adjust thread status counts */ - if (cleanup) { + if (thread->state & PERL_ITHR_DETACHED) { MY_POOL.detached_threads--; } else { MY_POOL.running_threads--; MY_POOL.joinable_threads++; } + MUTEX_UNLOCK(&thread->mutex); MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); /* Exit application if required */ @@ -497,10 +505,8 @@ S_ithread_run(void * arg) my_exit(exit_code); } - /* Clean up detached thread */ - if (cleanup) { - S_ithread_destruct(aTHX_ thread); - } + /* Try to clean up thread */ + S_ithread_destruct(aTHX_ thread); #ifdef WIN32 return ((DWORD)0); @@ -562,8 +568,6 @@ S_ithread_create( int exit_opt, SV *params) { - dMY_POOL; - ithread *thread; CLONE_PARAMS clone_param; ithread *current_thread = S_ithread_get(aTHX); @@ -574,8 +578,9 @@ S_ithread_create( int rc_stack_size = 0; int rc_thread_create = 0; #endif + dMY_POOL; - /* Allocate thread structure in context of the main threads interpreter */ + /* Allocate thread structure in context of the main thread's interpreter */ { PERL_SET_CONTEXT(MY_POOL.main_thread.interp); thread = (ithread *)PerlMemShared_malloc(sizeof(ithread)); @@ -758,6 +763,7 @@ S_ithread_create( /* Must unlock mutex for destruct call */ MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); sv_2mortal(params); + thread->state |= PERL_ITHR_NONVIABLE; S_ithread_destruct(aTHX_ thread); #ifndef WIN32 if (ckWARN_d(WARN_THREADS)) { @@ -908,10 +914,10 @@ ithread_create(...) XSRETURN_UNDEF; /* Mutex already unlocked */ } ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, FALSE)); + MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); /* Let thread run */ MUTEX_UNLOCK(&thread->mutex); - MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); /* XSRETURN(1); - implied */ @@ -1110,7 +1116,7 @@ ithread_detach(...) PREINIT: ithread *thread; int detach_err; - int cleanup; + int cleanup = 0; dMY_POOL; CODE: /* Check if the thread is detachable */ @@ -1132,21 +1138,18 @@ ithread_detach(...) #else PERL_THREAD_DETACH(thread->thr); #endif - /* Cleanup if finished */ - cleanup = (thread->state & PERL_ITHR_FINISHED); - MUTEX_UNLOCK(&thread->mutex); - if (cleanup) { + if (thread->state & PERL_ITHR_FINISHED) { MY_POOL.joinable_threads--; } else { MY_POOL.running_threads--; MY_POOL.detached_threads++; } + MUTEX_UNLOCK(&thread->mutex); MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); - if (cleanup) { - S_ithread_destruct(aTHX_ thread); - } + /* Try to cleanup thread */ + S_ithread_destruct(aTHX_ thread); void