From: Jerry D. Hedden Date: Mon, 3 Jul 2006 09:01:53 +0000 (-0700) Subject: threads 1.33 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4dcb9e53db5ab3b8d2b2f8eaba341cb2c0c5d2b8;p=p5sagit%2Fp5-mst-13.2.git threads 1.33 From: "Jerry D. Hedden" Message-ID: <20060703090153.fb30e530d17747c2b054d625b8945d88.b26e047e0f.wbe@email.secureserver.net> p4raw-id: //depot/perl@28475 --- diff --git a/MANIFEST b/MANIFEST index 0541b05..473888b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1166,6 +1166,7 @@ ext/threads/t/basic.t ithreads ext/threads/t/blocks.t Test threads in special blocks ext/threads/t/context.t Explicit thread context ext/threads/t/end.t Test end functions +ext/threads/t/exit.t Test exit and die in threads ext/threads/t/free2.t More ithread destruction tests ext/threads/t/free.t Test ithread destruction ext/threads/threads.pm ithreads diff --git a/ext/threads/Changes b/ext/threads/Changes index b4c9d54..c86f243 100755 --- a/ext/threads/Changes +++ b/ext/threads/Changes @@ -1,5 +1,14 @@ Revision history for Perl extension threads. +1.33 Mon Jul 3 10:11:20 EDT 2006 + - 'exit' inside a thread silently terminates thread only + - Added 'threads->exit()' (just calls CORE::exit(0)) + - Handle 'die/exit' in thread warn handlers if thread terminates + with a warning + - Give exact accounting of unjoined threads on program termination + - Fix spurious 'failures' from t/blocks.t + - Set correct path to threads module in tests that use test.pl + 1.32 Mon Jun 5 09:27:53 EDT 2006 - Fix for HP-UX 10.20 pthread_attr_getstacksize usage - Check for threads::shared in tests diff --git a/ext/threads/README b/ext/threads/README index 789411f..d8706ac 100755 --- a/ext/threads/README +++ b/ext/threads/README @@ -1,4 +1,4 @@ -threads version 1.32 +threads version 1.33 ==================== This module needs perl 5.8.0 or later compiled with 'useithreads'. diff --git a/ext/threads/t/blocks.t b/ext/threads/t/blocks.t index 1609a18..8c8a766 100644 --- a/ext/threads/t/blocks.t +++ b/ext/threads/t/blocks.t @@ -31,8 +31,15 @@ BEGIN { print("1..5\n"); ### Number of tests that will be run ### }; -my $TEST = 1; -share($TEST); +my ($TEST, $COUNT, $TOTAL); + +BEGIN { + share($TEST); + $TEST = 1; + share($COUNT); + $COUNT = 0; + $TOTAL = 0; +} ok(1, 'Loaded'); @@ -48,6 +55,7 @@ sub ok { } else { print("not ok $id - $name\n"); printf("# Failed test at line %d\n", (caller)[2]); + print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'})); } return ($ok); @@ -58,33 +66,45 @@ sub ok { $SIG{'__WARN__'} = sub { ok(0, "Warning: $_[0]"); }; -sub foo { } +sub foo { lock($COUNT); $COUNT++; } sub baz { 42 } my $bthr; BEGIN { $SIG{'__WARN__'} = sub { ok(0, "BEGIN: $_[0]"); }; + $TOTAL++; threads->create('foo')->join(); + $TOTAL++; threads->create(\&foo)->join(); - threads->create(sub {})->join(); + $TOTAL++; + threads->create(sub { lock($COUNT); $COUNT++; })->join(); + $TOTAL++; threads->create('foo')->detach(); + $TOTAL++; threads->create(\&foo)->detach(); - threads->create(sub {})->detach(); + $TOTAL++; + threads->create(sub { lock($COUNT); $COUNT++; })->detach(); $bthr = threads->create('baz'); } my $mthr; MAIN: { + $TOTAL++; threads->create('foo')->join(); + $TOTAL++; threads->create(\&foo)->join(); - threads->create(sub {})->join(); + $TOTAL++; + threads->create(sub { lock($COUNT); $COUNT++; })->join(); + $TOTAL++; threads->create('foo')->detach(); + $TOTAL++; threads->create(\&foo)->detach(); - threads->create(sub {})->detach(); + $TOTAL++; + threads->create(sub { lock($COUNT); $COUNT++; })->detach(); $mthr = threads->create('baz'); } @@ -95,8 +115,12 @@ ok($bthr, 'BEGIN thread'); ok($mthr->join() == 42, 'Main join'); ok($bthr->join() == 42, 'BEGIN join'); -# make sure a still-running detached thread doesn't give a warning on exit +# Wait for detached threads to finish +{ + threads->yield(); + sleep(1); + lock($COUNT); + redo if ($COUNT < $TOTAL); +} -# *** add new tests above this one -threads->create(sub { 1 while 1 })->detach(); -# *** add new tests above this one +# EOF diff --git a/ext/threads/t/context.t b/ext/threads/t/context.t index fe9ea83..fda0233 100644 --- a/ext/threads/t/context.t +++ b/ext/threads/t/context.t @@ -31,8 +31,11 @@ BEGIN { print("1..13\n"); ### Number of tests that will be run ### }; -my $TEST = 1; -share($TEST); +my $TEST; +BEGIN { + share($TEST); + $TEST = 1; +} ok(1, 'Loaded'); diff --git a/ext/threads/t/end.t b/ext/threads/t/end.t index 70d4188..b1955d9 100644 --- a/ext/threads/t/end.t +++ b/ext/threads/t/end.t @@ -31,8 +31,11 @@ BEGIN { print("1..6\n"); ### Number of tests that will be run ### }; -my $TEST = 1; -share($TEST); +my $TEST; +BEGIN { + share($TEST); + $TEST = 1; +} ok(1, 'Loaded'); diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t new file mode 100644 index 0000000..c0621c7 --- /dev/null +++ b/ext/threads/t/exit.t @@ -0,0 +1,256 @@ +use strict; +use warnings; + +BEGIN { + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + use Config; + if (! $Config{'useithreads'}) { + print("1..0 # Skip: Perl not compiled with 'useithreads'\n"); + exit(0); + } +} + +use ExtUtils::testlib; + +use threads; + +BEGIN { + eval { + require threads::shared; + import threads::shared; + }; + if ($@ || ! $threads::shared::threads_shared) { + print("1..0 # Skip: threads::shared not available\n"); + exit(0); + } + + $| = 1; + print("1..226\n"); ### Number of tests that will be run ### +}; + +my $TEST; +BEGIN { + share($TEST); + $TEST = 1; +} + +ok(1, 'Loaded'); + +sub ok { + my ($ok, $name) = @_; + if (! defined($name)) { + # Bug in test + $name = $ok; + $ok = 0; + } + chomp($name); + + lock($TEST); + my $id = $TEST++; + + # You have to do it this way or VMS will get confused. + if ($ok) { + print("ok $id - $name\n"); + } else { + print("not ok $id - $name\n"); + printf("# Failed test at line %d\n", (caller)[2]); + print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'})); + } + + return ($ok); +} + + +### Start of Testing ### + +$SIG{'__WARN__'} = sub { + my $msg = shift; + ok(0, "WARN in main: $msg"); +}; +$SIG{'__DIE__'} = sub { + my $msg = shift; + ok(0, "DIE in main: $msg"); +}; + + +sub nasty +{ + my ($term, $warn, $die) = @_; + my $tid = threads->tid(); + + $SIG{'__WARN__'} = sub { + my $msg = $_[0]; + ok($msg =~ /Thread \d+ terminated abnormally/, "WARN: $msg"); + if ($warn eq 'return') { + return ('# __WARN__ returned'); + } elsif ($warn eq 'die') { + die('# __WARN__ dying'); + } elsif ($warn eq 'exit') { + CORE::exit(20); + } else { + threads->exit(21); + } + }; + + $SIG{'__DIE__'} = sub { + my $msg = $_[0]; + ok(1, "DIE: $msg"); + if ($die eq 'return') { + return ('# __DIE__ returned'); + } elsif ($die eq 'die') { + die('# __DIE__ dying'); + } elsif ($die eq 'exit') { + CORE::exit(30); + } else { + threads->exit(31); + } + }; + + ok(1, "Thread $tid"); + if ($term eq 'return') { + return ('# Thread returned'); + } elsif ($term eq 'die') { + die('# Thread dying'); + } elsif ($term eq 'exit') { + CORE::exit(10); + } else { + threads->exit(11); + } +} + + +my @exit_types = qw(return die exit threads->exit); + +# Test (non-trivial) combinations of termination methods +# WRT the thread and its handlers +foreach my $die (@exit_types) { + foreach my $wrn (@exit_types) { + foreach my $thr (@exit_types) { + # Things are well behaved if the thread just returns + next if ($thr eq 'return'); + + # Skip combos with the die handler + # if neither the thread nor the warn handler dies + next if ($thr ne 'die' && $wrn ne 'die' && $die ne 'return'); + + # Must send STDERR to file to filter out 'un-capturable' output + my $rc; + eval { + local *STDERR; + if (! open(STDERR, '>tmp.stderr')) { + die('Failed to create "tmp.stderr"'); + } + + $rc = threads->create('nasty', $thr, $wrn, $die)->join(); + + close(STDERR); + }; + + # Filter out 'un-capturable' output + if (open(IN, 'tmp.stderr')) { + while (my $line = ) { + if ($line !~ /^#/) { + print(STDERR $line); + } + } + close(IN); + } else { + ok(0, "Failed to open 'tmp.stderr': $!"); + } + unlink('tmp.stderr'); + + ok(! $@, ($@) ? "Thread problem: $@" : "Thread ran okay"); + ok(! defined($rc), "Thread returned 'undef'"); + } + } +} + + +# Again with: +no warnings 'threads'; + +sub less_nasty +{ + my ($term, $warn, $die) = @_; + my $tid = threads->tid(); + + $SIG{'__WARN__'} = sub { + my $msg = $_[0]; + ok(0, "WARN: $msg"); + if ($warn eq 'return') { + return ('# __WARN__ returned'); + } elsif ($warn eq 'die') { + die('# __WARN__ dying'); + } elsif ($warn eq 'exit') { + CORE::exit(20); + } else { + threads->exit(21); + } + }; + + $SIG{'__DIE__'} = sub { + my $msg = $_[0]; + ok(1, "DIE: $msg"); + if ($die eq 'return') { + return ('# __DIE__ returned'); + } elsif ($die eq 'die') { + die('# __DIE__ dying'); + } elsif ($die eq 'exit') { + CORE::exit(30); + } else { + threads->exit(31); + } + }; + + ok(1, "Thread $tid"); + if ($term eq 'return') { + return ('# Thread returned'); + } elsif ($term eq 'die') { + die('# Thread dying'); + } elsif ($term eq 'exit') { + CORE::exit(10); + } else { + threads->exit(11); + } +} + +foreach my $die (@exit_types) { + foreach my $wrn (@exit_types) { + foreach my $thr (@exit_types) { + # Things are well behaved if the thread just returns + next if ($thr eq 'return'); + + # Skip combos with the die handler + # if neither the thread nor the warn handler dies + next if ($thr ne 'die' && $wrn ne 'die' && $die ne 'return'); + + my $rc; + eval { $rc = threads->create('less_nasty', $thr, $wrn, $die)->join() }; + ok(! $@, ($@) ? "Thread problem: $@" : "Thread ran okay"); + ok(! defined($rc), "Thread returned 'undef'"); + } + } +} + + +# Check termination warning concerning running threads +$SIG{'__WARN__'} = sub { + my $msg = shift; + ok($msg =~ /1 running and unjoined/, '1 running and unjoined'); + ok($msg =~ /2 finished and unjoined/, '2 finished and unjoined'); + ok($msg =~ /3 running and detached/, '3 finished and detached'); +}; + +threads->create(sub { sleep(100); }); +threads->create(sub {}); +threads->create(sub {}); +threads->create(sub { sleep(100); })->detach(); +threads->create(sub { sleep(100); })->detach(); +threads->create(sub { sleep(100); })->detach(); +threads->yield(); +sleep(1); + +# EOF diff --git a/ext/threads/t/free.t b/ext/threads/t/free.t index 703ba38..0e8bd86 100644 --- a/ext/threads/t/free.t +++ b/ext/threads/t/free.t @@ -31,8 +31,11 @@ BEGIN { print("1..29\n"); ### Number of tests that will be run ### }; -my $TEST = 1; -share($TEST); +my $TEST; +BEGIN { + share($TEST); + $TEST = 1; +} ok(1, 'Loaded'); diff --git a/ext/threads/t/free2.t b/ext/threads/t/free2.t index da50652..eb33da1 100644 --- a/ext/threads/t/free2.t +++ b/ext/threads/t/free2.t @@ -36,8 +36,11 @@ BEGIN { print("1..74\n"); ### Number of tests that will be run ### }; -my $TEST = 1; -share($TEST); +my $TEST; +BEGIN { + share($TEST); + $TEST = 1; +} ok(1, 'Loaded'); diff --git a/ext/threads/t/join.t b/ext/threads/t/join.t index 1f64044..bebfd6d 100644 --- a/ext/threads/t/join.t +++ b/ext/threads/t/join.t @@ -31,8 +31,11 @@ BEGIN { print("1..17\n"); ### Number of tests that will be run ### }; -my $TEST = 1; -share($TEST); +my $TEST; +BEGIN { + share($TEST); + $TEST = 1; +} ok(1, 'Loaded'); diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t index 0f037d6..73b7e3a 100644 --- a/ext/threads/t/thread.t +++ b/ext/threads/t/thread.t @@ -160,22 +160,22 @@ package main; ok($th->join()); } { - # There is a slight chance (<< 1%) this test case will falsely fail + # There is a miniscule chance this test case may falsely fail # since it tests using rand() my %rand : shared; rand(10); threads->create( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25; $_->join foreach threads->list; -# use Data::Dumper qw(Dumper); -# print Dumper(\%rand); - #$val = rand(); - ok((keys %rand >= 24), "Check that rand() works after a new thread"); + ok((keys %rand >= 23), "Check that rand() is randomized in new threads"); } # bugid #24165 -run_perl(prog => - 'use threads; sub a{threads->create(shift)} $t = a sub{}; $t->tid; $t->join; $t->tid'); +run_perl(prog => 'use threads 1.33; + sub a{threads->create(shift)} $t = a sub{}; + $t->tid; $t->join; $t->tid', + nolib => ($ENV{PERL_CORE}) ? 0 : 1, + switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); is($?, 0, 'coredump in global destruction'); # test CLONE_SKIP() functionality diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm index 806af44..7e5cffb 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.32'; +our $VERSION = '1.33'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -74,6 +74,12 @@ sub import ### Methods, etc. ### +# Our own exit function/method +sub exit +{ + CORE::exit(0); +} + # 'new' is an alias for 'create' *new = \&create; @@ -102,7 +108,7 @@ threads - Perl interpreter-based threads =head1 VERSION -This document describes threads version 1.32 +This document describes threads version 1.33 =head1 SYNOPSIS @@ -157,6 +163,8 @@ This document describes threads version 1.32 $thr->kill('SIGUSR1'); + threads->exit(); + =head1 DESCRIPTION Perl 5.6 introduced something called interpreter threads. Interpreter threads @@ -237,10 +245,8 @@ is determined at the time of thread creation. See L for more details. -If the program exits without all other threads having been either joined or -detached, then a warning will be issued. (A program exits either because one -of its threads explicitly calls L, or in the case -of the main thread, reaches the end of the main program file.) +If the program exits without all threads having either been joined or +detached, then a warning will be issued. Calling C<-Ejoin()> or C<-Edetach()> on an already joined thread will cause an error to be thrown. @@ -248,7 +254,11 @@ cause an error to be thrown. =item $thr->detach() Makes the thread unjoinable, and causes any eventual return value to be -discarded. +discarded. When the program exits, any detached threads that are still +running are silently terminated. + +If the program exits without all threads having either been joined or +detached, then a warning will be issued. Calling C<-Ejoin()> or C<-Edetach()> on an already detached thread will cause an error to be thrown. @@ -257,6 +267,27 @@ will cause an error to be thrown. Class method that allows a thread to detach itself. +=item threads->exit() + +The usual method for terminating a thread is to +L from the entry point function with the +appropriate return value(s). + +If needed, a thread can be exited at any time by calling +Cexit()>. This will cause the thread to return C in a +scalar context, or the empty list in a list context. + +Calling C in a thread indicates an abnormal exit for the thread. Any +C<$SIG{__DIE__}> handler in the thread will be called first, and then the +thread will exit with a warning message that will contain any arguments passed +in the C call. + +Calling C in a thread is discouraged, but is equivalent to calling +Cexit()>. + +If the desired affect is to truly terminate the application from a thread, +then use L, if available. + =item threads->self() Class method that allows a thread to obtain its own I object. @@ -566,12 +597,13 @@ such that the signal is acted up immediately. =over 4 -=item A thread exited while # other threads were still running +=item Perl exited with active threads: -A thread (not necessarily the main thread) exited while there were still other -threads running. Usually, it's a good idea to first collect the return values -of the created threads by joining them, and only then exit from the main -thread. +If the program exits without all threads having either been joined or +detached, then this warning will be issued. + +NOTE: This warning cannot be suppressed using C as +suggested below. =item Thread creation failed: pthread_create returned # @@ -581,7 +613,7 @@ cause for the failure. =item Thread # terminated abnormally: ... A thread terminated in some manner other than just returning from its entry -point function. For example, the thread may have exited via C. +point function. For example, the thread may have terminated using C. =item Using minimum thread stack size of # @@ -623,7 +655,7 @@ following results in the above error: $thr->set_stack_size($size); -=item Cannot signal other threads without safe signals +=item Cannot signal threads without safe signals Safe signals must be in effect to use the C<-Ekill()> signalling method. See L for more details. @@ -705,7 +737,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 3208fd1..5e6d16c 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -2,6 +2,11 @@ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +/* Workaround for XSUB.h bug under WIN32 */ +#ifdef WIN32 +# undef setjmp +# define setjmp(x) _setjmp(x) +#endif #ifdef HAS_PPPORT_H # define NEED_PL_signals # define NEED_newRV_noinc @@ -81,8 +86,9 @@ static ithread *threads; static perl_mutex create_destruct_mutex; static UV tid_counter = 0; -static IV active_threads = 0; static IV joinable_threads = 0; +static IV running_threads = 0; +static IV detached_threads = 0; #ifdef THREAD_CREATE_NEEDS_STACK static IV default_stack_size = THREAD_CREATE_NEEDS_STACK; #else @@ -155,11 +161,11 @@ S_ithread_destruct(pTHX_ ithread *thread) return; } - MUTEX_LOCK(&create_destruct_mutex); /* Main thread (0) is immortal and should never get here */ assert(thread->tid != 0); /* Remove from circular list of threads */ + MUTEX_LOCK(&create_destruct_mutex); thread->next->prev = thread->prev; thread->prev->next = thread->next; thread->next = NULL; @@ -195,9 +201,17 @@ Perl_ithread_hook(pTHX) { int veto_cleanup = 0; MUTEX_LOCK(&create_destruct_mutex); - if ((aTHX == PL_curinterp) && (joinable_threads != 1)) { + if ((aTHX == PL_curinterp) && + (running_threads || joinable_threads)) + { if (ckWARN_d(WARN_THREADS)) { - Perl_warn(aTHX_ "A thread exited while %" IVdf " threads were running", joinable_threads); + Perl_warn(aTHX_ "Perl exited with active threads:\n\t%" + IVdf " running and unjoined\n\t%" + IVdf " finished and unjoined\n\t%" + IVdf " running and detached\n", + running_threads, + joinable_threads, + detached_threads); } veto_cleanup = 1; } @@ -266,7 +280,7 @@ good_stack_size(pTHX_ IV stack_size) #ifdef PTHREAD_STACK_MIN /* Can't use less than minimum */ if (stack_size < PTHREAD_STACK_MIN) { - if (ckWARN_d(WARN_THREADS)) { + if (ckWARN(WARN_THREADS)) { Perl_warn(aTHX_ "Using minimum thread stack size of %" IVdf, (IV)PTHREAD_STACK_MIN); } return (PTHREAD_STACK_MIN); @@ -346,6 +360,10 @@ S_ithread_run(void * arg) AV *params = (AV *)SvRV(thread->params); int len = (int)av_len(params)+1; int ii; + int jmp_rc = 0; + I32 oldscope; + + dJMPENV; dSP; ENTER; @@ -358,24 +376,44 @@ S_ithread_run(void * arg) } PUTBACK; - /* Run the specified function */ - len = (int)call_sv(thread->init_function, thread->gimme|G_EVAL); + oldscope = PL_scopestack_ix; + JMPENV_PUSH(jmp_rc); + if (jmp_rc == 0) { + /* Run the specified function */ + len = (int)call_sv(thread->init_function, thread->gimme|G_EVAL); + } else if (jmp_rc == 2) { + while (PL_scopestack_ix > oldscope) { + LEAVE; + } + } + JMPENV_POP; /* Remove args from stack and put back in params array */ SPAGAIN; for (ii=len-1; ii >= 0; ii--) { SV *sv = POPs; - av_store(params, ii, SvREFCNT_inc(sv)); + if (jmp_rc == 0) { + av_store(params, ii, SvREFCNT_inc(sv)); + } } + FREETMPS; + LEAVE; + /* Check for failure */ if (SvTRUE(ERRSV) && ckWARN_d(WARN_THREADS)) { - Perl_warn(aTHX_ "Thread %" UVuf " terminated abnormally: %" SVf, thread->tid, ERRSV); + oldscope = PL_scopestack_ix; + JMPENV_PUSH(jmp_rc); + if (jmp_rc == 0) { + Perl_warn(aTHX_ "Thread %" UVuf " terminated abnormally: %" SVf, thread->tid, ERRSV); + } else if (jmp_rc == 2) { + while (PL_scopestack_ix > oldscope) { + LEAVE; + } + } + JMPENV_POP; } - FREETMPS; - LEAVE; - /* Release function ref */ SvREFCNT_dec(thread->init_function); thread->init_function = Nullsv; @@ -390,15 +428,17 @@ S_ithread_run(void * arg) cleanup = (thread->state & PERL_ITHR_DETACHED); MUTEX_UNLOCK(&thread->mutex); - if (cleanup) + if (cleanup) { + MUTEX_LOCK(&create_destruct_mutex); + detached_threads--; + MUTEX_UNLOCK(&create_destruct_mutex); S_ithread_destruct(aTHX_ thread); - - MUTEX_LOCK(&create_destruct_mutex); - active_threads--; - if (!cleanup) { - joinable_threads--; + } else { + MUTEX_LOCK(&create_destruct_mutex); + running_threads--; + joinable_threads++; + MUTEX_UNLOCK(&create_destruct_mutex); } - MUTEX_UNLOCK(&create_destruct_mutex); #ifdef WIN32 return ((DWORD)0); @@ -657,8 +697,7 @@ S_ithread_create( return (&PL_sv_undef); } - active_threads++; - joinable_threads++; + running_threads++; MUTEX_UNLOCK(&create_destruct_mutex); sv_2mortal(params); @@ -685,7 +724,6 @@ ithread_create(...) IV stack_size; int context; char *str; - char ch; int idx; int ii; CODE: @@ -920,6 +958,10 @@ ithread_join(...) S_ithread_clear(aTHX_ thread); MUTEX_UNLOCK(&thread->mutex); + MUTEX_LOCK(&create_destruct_mutex); + joinable_threads--; + MUTEX_UNLOCK(&create_destruct_mutex); + /* If no return values, then just return */ if (! params) { XSRETURN_UNDEF; @@ -973,13 +1015,18 @@ ithread_detach(...) cleanup = (thread->state & PERL_ITHR_FINISHED); MUTEX_UNLOCK(&thread->mutex); - if (cleanup) + MUTEX_LOCK(&create_destruct_mutex); + if (cleanup) { + joinable_threads--; + } else { + running_threads--; + detached_threads++; + } + MUTEX_UNLOCK(&create_destruct_mutex); + + if (cleanup) { S_ithread_destruct(aTHX_ thread); - else { - MUTEX_LOCK(&create_destruct_mutex); - joinable_threads--; - MUTEX_UNLOCK(&create_destruct_mutex); - } + } void @@ -991,15 +1038,12 @@ ithread_kill(...) CODE: /* Must have safe signals */ if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) - Perl_croak(aTHX_ "Cannot signal other threads without safe signals"); + Perl_croak(aTHX_ "Cannot signal threads without safe signals"); /* Object method only */ if (! sv_isobject(ST(0))) Perl_croak(aTHX_ "Usage: $thr->kill('SIG...')"); - /* Get thread */ - thread = SV_to_ithread(aTHX_ ST(0)); - /* Get signal */ sig_name = SvPV_nolen(ST(1)); if (isALPHA(*sig_name)) { @@ -1011,11 +1055,14 @@ ithread_kill(...) signal = SvIV(ST(1)); /* Set the signal for the thread */ + thread = SV_to_ithread(aTHX_ ST(0)); + MUTEX_LOCK(&thread->mutex); { dTHXa(thread->interp); PL_psig_pend[signal]++; PL_sig_pending = 1; } + MUTEX_UNLOCK(&thread->mutex); /* Return the thread to allow for method chaining */ ST(0) = ST(0); @@ -1164,7 +1211,6 @@ BOOT: } Zero(thread, 1, ithread); - PL_perl_destruct_level = 2; MUTEX_INIT(&thread->mutex); thread->tid = tid_counter++; /* Thread 0 */ @@ -1185,9 +1231,6 @@ BOOT: thread->thr = pthread_self(); # endif - active_threads++; - joinable_threads++; - S_ithread_set(aTHX_ thread); MUTEX_UNLOCK(&create_destruct_mutex); #endif /* USE_ITHREADS */