From: Rafael Garcia-Suarez Date: Thu, 25 Jan 2007 14:48:49 +0000 (+0000) Subject: Upgrade to threads 1.58: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6ebc233ed33de510dfa9becc9d8efa75c8d25d33;p=p5sagit%2Fp5-mst-13.2.git Upgrade to threads 1.58: * Ignore thread return value(s) in void context * Check for missing args for 'use threads' options * Check that stack size argument is numeric p4raw-id: //depot/perl@29973 --- diff --git a/ext/threads/Changes b/ext/threads/Changes index 637926f..6eec369 100755 --- a/ext/threads/Changes +++ b/ext/threads/Changes @@ -1,5 +1,11 @@ Revision history for Perl extension threads. +1.58 Wed Jan 24 13:15:34 EST 2007 + - Fix race conditions on thread destruction (Dave Mitchell) + - Ignore thread return value(s) in void context + - Check for missing args for 'use threads' options + - Check that stack size argument is numeric + 1.57 Wed Dec 20 13:10:26 EST 2006 - Fixes courtesy of Michael J. Pomraning Eliminates self joins. diff --git a/ext/threads/README b/ext/threads/README index 210d012..0194702 100755 --- a/ext/threads/README +++ b/ext/threads/README @@ -1,4 +1,4 @@ -threads version 1.57 +threads version 1.58 ==================== This module exposes interpreter threads to the Perl level. diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t index 49549a9..a85c411 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.57;' . +run_perl(prog => 'use threads 1.58;' . '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.57 qw(exit thread_only);' . +run_perl(prog => 'use threads 1.58 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.57 qw(exit thread_only);' . is($?>>8, 86, "'use threads 'exit' => 'thread_only'"); -my $out = run_perl(prog => 'use threads 1.57;' . +my $out = run_perl(prog => 'use threads 1.58;' . 'threads->create(sub {' . ' exit(99);' . '});' . @@ -125,7 +125,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.57 qw(exit thread_only);' . +$out = run_perl(prog => 'use threads 1.58 qw(exit thread_only);' . 'threads->create(sub {' . ' threads->set_thread_exit_only(0);' . ' exit(99);' . @@ -139,7 +139,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.57;' . +run_perl(prog => 'use threads 1.58;' . 'threads->create(sub {' . ' $SIG{__WARN__} = sub { exit(99); };' . ' die();' . diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t index 7e71900..6020807 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.57;' . +run_perl(prog => 'use threads 1.58;' . '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 69214b3..e487f3b 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.57'; +our $VERSION = '1.58'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -47,17 +47,22 @@ sub import # Handle args while (my $sym = shift) { - if ($sym =~ /^stack/i) { - threads->set_stack_size(shift); - - } elsif ($sym =~ /^exit/i) { - my $flag = shift; - $threads::thread_exit_only = $flag =~ /^thread/i; + if ($sym =~ /^(?:stack|exit)/i) { + if (defined(my $arg = shift)) { + if ($sym =~ /^stack/i) { + threads->set_stack_size($arg); + } else { + $threads::thread_exit_only = $arg =~ /^thread/i; + } + } else { + require Carp; + Carp::croak("threads: Missing argument for option: $sym"); + } } elsif ($sym =~ /^str/i) { import overload ('""' => \&tid); - } elsif ($sym =~ /(?:all|yield)/) { + } elsif ($sym =~ /^(?:all|yield)$/) { push(@EXPORT, qw(yield)); } else { @@ -133,7 +138,7 @@ threads - Perl interpreter-based threads =head1 VERSION -This document describes threads version 1.57 +This document describes threads version 1.58 =head1 SYNOPSIS @@ -230,8 +235,11 @@ for emulating fork() on Windows. The I API is loosely based on the old Thread.pm API. It is very important to note that variables are not shared between threads, all variables -are by default thread local. To use shared variables one must use -L. +are by default thread local. To use shared variables one must also use +L: + + use threads; + use threads::shared; It is also important to note that you must enable threads by doing C as early as possible in the script itself, and that it is not @@ -949,7 +957,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 80671ee..eb96414 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -45,12 +45,12 @@ typedef perl_os_thread pthread_t; #endif /* Values for 'state' member */ -#define PERL_ITHR_DETACHED 1 /* thread has been detached */ -#define PERL_ITHR_JOINED 2 /* thread has been joined */ -#define PERL_ITHR_FINISHED 4 /* thread has finished execution */ +#define PERL_ITHR_DETACHED 1 /* Thread has been detached */ +#define PERL_ITHR_JOINED 2 /* Thread has been joined */ +#define PERL_ITHR_FINISHED 4 /* Thread has finished execution */ #define PERL_ITHR_THREAD_EXIT_ONLY 8 /* exit() only exits current thread */ -#define PERL_ITHR_NONVIABLE 16 /* thread creation failed */ -#define PERL_ITHR_DIED 32 /* thread finished by dying */ +#define PERL_ITHR_NONVIABLE 16 /* Thread creation failed */ +#define PERL_ITHR_DIED 32 /* Thread finished by dying */ #define PERL_ITHR_UNCALLABLE (PERL_ITHR_DETACHED|PERL_ITHR_JOINED) @@ -61,7 +61,7 @@ typedef struct _ithread { PerlInterpreter *interp; /* The threads interpreter */ UV tid; /* Threads module's thread id */ perl_mutex mutex; /* Mutex for updating things in this struct */ - int count; /* reference count. See S_ithread_create */ + int count; /* Reference count. See S_ithread_create. */ int state; /* Detached, joined, finished, etc. */ int gimme; /* Context of create */ SV *init_function; /* Code to run */ @@ -133,7 +133,10 @@ S_ithread_get(pTHX) /* Free any data (such as the Perl interpreter) attached to an ithread * structure. This is a bit like undef on SVs, where the SV isn't freed, - * but the PVX is. Must be called with thread->mutex already held. + * but the PVX is. Must be called with thread->mutex already locked. Also, + * must be called with MY_POOL.create_destruct_mutex unlocked as destruction + * of the interpreter can lead to recursive destruction calls that could + * lead to a deadlock on that mutex. */ STATIC void S_ithread_clear(pTHX_ ithread *thread) @@ -171,8 +174,8 @@ S_ithread_clear(pTHX_ ithread *thread) /* Decrement the refcount of an ithread, and if it reaches zero, free it. * Must be called with the mutex held. - * On return, mutex is released (or destroyed) */ - + * On return, mutex is released (or destroyed). + */ STATIC void S_ithread_free(pTHX_ ithread *thread) { @@ -187,8 +190,8 @@ S_ithread_free(pTHX_ ithread *thread) MUTEX_UNLOCK(&thread->mutex); return; } - assert((thread->state & PERL_ITHR_FINISHED) - && (thread->state & PERL_ITHR_UNCALLABLE)); + assert((thread->state & PERL_ITHR_FINISHED) && + (thread->state & PERL_ITHR_UNCALLABLE)); } MUTEX_UNLOCK(&thread->mutex); @@ -225,9 +228,9 @@ S_ithread_free(pTHX_ ithread *thread) /* total_threads >= 1 is used to veto cleanup by the main thread, * should it happen to exit while other threads still exist. - * Decrement this as the very last thing in the thread's existence, - * otherwise MY_POOL and global state such as PL_op_mutex may get - * freed while we're still using it + * Decrement this as the very last thing in the thread's existence. + * Otherwise, MY_POOL and global state such as PL_op_mutex may get + * freed while we're still using it. */ MUTEX_LOCK(&MY_POOL.create_destruct_mutex); MY_POOL.total_threads--; @@ -235,7 +238,6 @@ S_ithread_free(pTHX_ ithread *thread) } - static void S_ithread_count_inc(pTHX_ ithread *thread) { @@ -245,7 +247,6 @@ S_ithread_count_inc(pTHX_ ithread *thread) } - /* Warn if exiting with any unjoined threads */ STATIC int S_exit_warning(pTHX) @@ -273,10 +274,10 @@ S_exit_warning(pTHX) return (veto_cleanup); } -/* Called from perl_destruct() in each thread. If it's the main thread, - * stop it from freeing everything if there are other threads still - * running */ +/* Called from perl_destruct() in each thread. If it's the main thread, + * stop it from freeing everything if there are other threads still running. + */ int Perl_ithread_hook(pTHX) { @@ -301,11 +302,10 @@ ithread_mg_free(pTHX_ SV *sv, MAGIC *mg) { ithread *thread = (ithread *)mg->mg_ptr; MUTEX_LOCK(&thread->mutex); - S_ithread_free(aTHX_ thread); /* releases MUTEX */ + S_ithread_free(aTHX_ thread); /* Releases MUTEX */ return (0); } - int ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) { @@ -535,14 +535,14 @@ S_ithread_run(void * arg) my_exit(exit_code); } - /* at this point the interpreter may have been freed, so call - * free in the context of of the 'main' interpreter. That can't have - * been freed, due to the veto_cleanup mechanism */ - + /* At this point, the interpreter may have been freed, so call + * free in the the context of of the 'main' interpreter which + * can't have been freed due to the veto_cleanup mechanism. + */ aTHX = MY_POOL.main_thread.interp; MUTEX_LOCK(&thread->mutex); - S_ithread_free(aTHX_ thread); /* releases MUTEX */ + S_ithread_free(aTHX_ thread); /* Releases MUTEX */ #ifdef WIN32 return ((DWORD)0); @@ -631,13 +631,13 @@ S_ithread_create( thread->prev->next = thread; MY_POOL.total_threads++; - /* 1 ref to be held by the local var 'thread' in S_ithread_run() + /* 1 ref to be held by the local var 'thread' in S_ithread_run(). * 1 ref to be held by the threads object that we assume we will - * be embedded in upon our return - * 1 ref to be the responsibility of join/detach, so we don't get freed - until join/detach, even if no thread objects remain. This - allows the following to work: - { threads->new(sub{...}); } threads->object(1)->join; + * be embedded in upon our return. + * 1 ref to be the responsibility of join/detach, so we don't get + * freed until join/detach, even if no thread objects remain. + * This allows the following to work: + * { threads->new(sub{...}); } threads->object(1)->join; */ thread->count = 3; @@ -803,7 +803,7 @@ S_ithread_create( MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); sv_2mortal(params); thread->state |= PERL_ITHR_NONVIABLE; - S_ithread_free(aTHX_ thread); /* releases MUTEX */ + S_ithread_free(aTHX_ thread); /* Releases MUTEX */ #ifndef WIN32 if (ckWARN_d(WARN_THREADS)) { if (rc_stack_size) { @@ -1064,7 +1064,7 @@ ithread_join(...) ithread *thread; ithread *current_thread; int join_err; - AV *params; + AV *params = NULL; int len; int ii; #ifdef WIN32 @@ -1120,7 +1120,7 @@ ithread_join(...) MUTEX_LOCK(&thread->mutex); /* Get the return value from the call_sv */ /* Objects do not survive this process - FIXME */ - { + if (! (thread->gimme & G_VOID)) { AV *params_copy; PerlInterpreter *other_perl; CLONE_PARAMS clone_params; @@ -1147,7 +1147,7 @@ ithread_join(...) if (! (thread->state & PERL_ITHR_DIED)) { S_ithread_clear(aTHX_ thread); } - S_ithread_free(aTHX_ thread); /* releases MUTEX */ + S_ithread_free(aTHX_ thread); /* Releases MUTEX */ /* If no return values, then just return */ if (! params) { @@ -1217,8 +1217,7 @@ ithread_detach(...) { S_ithread_clear(aTHX_ thread); } - S_ithread_free(aTHX_ thread); /* releases MUTEX */ - + S_ithread_free(aTHX_ thread); /* Releases MUTEX */ void @@ -1392,6 +1391,9 @@ ithread_set_stack_size(...) if (sv_isobject(ST(0))) { Perl_croak(aTHX_ "Cannot change stack size of an existing thread"); } + if (! looks_like_number(ST(1))) { + Perl_croak(aTHX_ "Stack size must be numeric"); + } old_size = MY_POOL.default_stack_size; MY_POOL.default_stack_size = S_good_stack_size(aTHX_ SvIV(ST(1)));