From: Jerry D. Hedden Date: Sun, 10 Sep 2006 09:12:06 +0000 (-0700) Subject: Bump version and other misc. changes. 3rd patch from: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fea7688c419f77f70fbdf9124ff5cef2c8a4be23;p=p5sagit%2Fp5-mst-13.2.git Bump version and other misc. changes. 3rd patch from: Subject: [PATCH] thread 1.41 - A drama in three parts From: "Jerry D. Hedden" Message-ID: <20060910091206.fb30e530d17747c2b054d625b8945d88.321c7cbc94.wbe@email.secureserver.net> p4raw-id: //depot/perl@28835 --- diff --git a/ext/threads/Changes b/ext/threads/Changes index e2f405a..f4acc64 100755 --- a/ext/threads/Changes +++ b/ext/threads/Changes @@ -1,5 +1,12 @@ Revision history for Perl extension threads. +1.41 Fri Sep 8 19:28:41 EST 2006 + - Race condition fixes + +1.39 Tue Aug 30 12:00:00 EDT 2006 + - Signals are safe in 5.8.0 + - Upgraded ppport.h to Devel::PPPort 3.10 + 1.38 Tue Aug 1 11:48:56 EDT 2006 - Fixes to tests diff --git a/ext/threads/README b/ext/threads/README index 66fe5ec..79c0b4b 100755 --- a/ext/threads/README +++ b/ext/threads/README @@ -1,4 +1,4 @@ -threads version 1.38 +threads version 1.41 ==================== This module exposes interpreter threads to the Perl level. diff --git a/ext/threads/t/state.t b/ext/threads/t/state.t index 331cd8c..80724db 100644 --- a/ext/threads/t/state.t +++ b/ext/threads/t/state.t @@ -180,7 +180,7 @@ ok($thr->is_detached(), 'thread detached'); ok(! $thr->is_joinable(), 'thread not joinable'); ok(threads->list(threads::joinable) == 0, 'thread joinable list'); -$thr = threads->create(sub { +threads->create(sub { ok(! threads->is_detached(), 'thread not detached'); ok(threads->list(threads::running) == 1, 'thread running list'); ok(threads->list(threads::joinable) == 0, 'thread joinable list'); diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t index 6fab98e..c583cbc 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.38;' . +run_perl(prog => 'use threads 1.41;' . '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 2970321..630d9a2 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.38'; +our $VERSION = '1.41'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -129,7 +129,7 @@ threads - Perl interpreter-based threads =head1 VERSION -This document describes threads version 1.38 +This document describes threads version 1.41 =head1 SYNOPSIS @@ -139,13 +139,13 @@ This document describes threads version 1.38 my @args = @_; print('Thread started: ', join(' ', @args), "\n"); } - my $thread = threads->create('start_thread', 'argument'); - $thread->join(); + my $thr = threads->create('start_thread', 'argument'); + $thr->join(); threads->create(sub { print("I am a thread\n"); })->join(); - my $thread3 = async { foreach (@files) { ... } }; - $thread3->join(); + my $thr2 = async { foreach (@files) { ... } }; + $thr2->join(); # Invoke thread in list context (implicit) so it can return a list my ($thr) = threads->create(sub { return (qw/a b c/); }); @@ -154,16 +154,15 @@ This document describes threads version 1.38 sub { return (qw/a b c/); }); my @results = $thr->join(); - $thread->detach(); + $thr->detach(); # Get a thread's object - $thread = threads->self(); - $thread = threads->object($tid); + $thr = threads->self(); + $thr = threads->object($tid); # Get a thread's ID $tid = threads->tid(); - $tid = threads->self->tid(); - $tid = $thread->tid(); + $tid = $thr->tid(); # Give other threads a chance to run threads->yield(); @@ -887,7 +886,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 395644d..571801f 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -154,7 +154,7 @@ S_ithread_destruct(pTHX_ ithread *thread) #ifdef WIN32 HANDLE handle; #endif - /* Thread is still in use */ + /* Return if thread is still being used */ if (thread->count != 0) { return; } @@ -182,8 +182,9 @@ S_ithread_destruct(pTHX_ ithread *thread) MUTEX_DESTROY(&thread->mutex); #ifdef WIN32 - if (handle) + if (handle) { CloseHandle(handle); + } #endif /* Call PerlMemShared_free() in the context of the "first" interpreter @@ -250,8 +251,9 @@ ithread_mg_free(pTHX_ SV *sv, MAGIC *mg) (thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))); MUTEX_UNLOCK(&thread->mutex); - if (cleanup) + if (cleanup) { S_ithread_destruct(aTHX_ thread); + } return (0); } @@ -281,8 +283,9 @@ static IV good_stack_size(pTHX_ IV stack_size) { /* Use default stack size if no stack size specified */ - if (! stack_size) + if (! stack_size) { return (default_stack_size); + } #ifdef PTHREAD_STACK_MIN /* Can't use less than minimum */ @@ -322,8 +325,9 @@ good_stack_size(pTHX_ IV stack_size) page_size = 8192; /* A conservative default */ # endif # endif - if (page_size <= 0) + if (page_size <= 0) { Perl_croak(aTHX_ "PANIC: bad pagesize %" IVdf, (IV)page_size); + } #endif } stack_size = ((stack_size + (page_size - 1)) / page_size) * page_size; @@ -436,8 +440,9 @@ S_ithread_run(void * arg) /* Mark as finished */ thread->state |= PERL_ITHR_FINISHED; /* Clear exit flag if required */ - if (thread->state & PERL_ITHR_THREAD_EXIT_ONLY) + if (thread->state & PERL_ITHR_THREAD_EXIT_ONLY) { exit_app = 0; + } /* Cleanup if detached */ cleanup = (thread->state & PERL_ITHR_DETACHED); MUTEX_UNLOCK(&thread->mutex); @@ -471,8 +476,9 @@ S_ithread_run(void * arg) } /* Clean up detached thread */ - if (cleanup) + if (cleanup) { S_ithread_destruct(aTHX_ thread); + } #ifdef WIN32 return ((DWORD)0); @@ -483,6 +489,7 @@ S_ithread_run(void * arg) /* Type conversion helper functions */ + static SV * ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc) { @@ -726,10 +733,11 @@ S_ithread_create( S_ithread_destruct(aTHX_ thread); #ifndef WIN32 if (ckWARN_d(WARN_THREADS)) { - if (rc_stack_size) + if (rc_stack_size) { Perl_warn(aTHX_ "Thread creation failed: pthread_attr_setstacksize(%" IVdf ") returned %d", thread->stack_size, rc_stack_size); - else + } else { Perl_warn(aTHX_ "Thread creation failed: pthread_create returned %d", rc_thread_create); + } } #endif return (NULL); @@ -765,13 +773,15 @@ ithread_create(...) int ii; CODE: if ((items >= 2) && SvROK(ST(1)) && SvTYPE(SvRV(ST(1)))==SVt_PVHV) { - if (--items < 2) + if (--items < 2) { Perl_croak(aTHX_ "Usage: threads->create(\\%specs, function, ...)"); + } specs = (HV*)SvRV(ST(1)); idx = 1; } else { - if (items < 2) + if (items < 2) { Perl_croak(aTHX_ "Usage: threads->create(function, ...)"); + } specs = NULL; idx = 0; } @@ -887,8 +897,9 @@ ithread_list(...) int want_running; PPCODE: /* Class method only */ - if (SvROK(ST(0))) + if (SvROK(ST(0))) { Perl_croak(aTHX_ "Usage: threads->list(...)"); + } classname = (char *)SvPV_nolen(ST(0)); /* Calling context */ @@ -943,8 +954,9 @@ ithread_self(...) ithread *thread; CODE: /* Class method only */ - if (SvROK(ST(0))) + if (SvROK(ST(0))) { Perl_croak(aTHX_ "Usage: threads->self()"); + } classname = (char *)SvPV_nolen(ST(0)); thread = S_ithread_get(aTHX); @@ -978,8 +990,9 @@ ithread_join(...) #endif PPCODE: /* Object method only */ - if (! sv_isobject(ST(0))) + if (! sv_isobject(ST(0))) { Perl_croak(aTHX_ "Usage: $thr->join()"); + } /* Check if the thread is joinable */ thread = SV_to_ithread(aTHX_ ST(0)); @@ -1112,22 +1125,27 @@ ithread_kill(...) IV signal; CODE: /* Must have safe signals */ - if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) + if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) { Perl_croak(aTHX_ "Cannot signal threads without safe signals"); + } /* Object method only */ - if (! sv_isobject(ST(0))) + if (! sv_isobject(ST(0))) { Perl_croak(aTHX_ "Usage: $thr->kill('SIG...')"); + } /* Get signal */ sig_name = SvPV_nolen(ST(1)); if (isALPHA(*sig_name)) { - if (*sig_name == 'S' && sig_name[1] == 'I' && sig_name[2] == 'G') + if (*sig_name == 'S' && sig_name[1] == 'I' && sig_name[2] == 'G') { sig_name += 3; - if ((signal = whichsig(sig_name)) < 0) + } + if ((signal = whichsig(sig_name)) < 0) { Perl_croak(aTHX_ "Unrecognized signal name: %s", sig_name); - } else + } + } else { signal = SvIV(ST(1)); + } /* Set the signal for the thread */ thread = SV_to_ithread(aTHX_ ST(0)); @@ -1179,8 +1197,9 @@ ithread_object(...) int have_obj = 0; CODE: /* Class method only */ - if (SvROK(ST(0))) + if (SvROK(ST(0))) { Perl_croak(aTHX_ "Usage: threads->object($tid)"); + } classname = (char *)SvPV_nolen(ST(0)); if ((items < 2) || ! SvOK(ST(1))) { @@ -1251,10 +1270,12 @@ ithread_set_stack_size(...) PREINIT: IV old_size; CODE: - if (items != 2) + if (items != 2) { Perl_croak(aTHX_ "Usage: threads->set_stack_size($size)"); - if (sv_isobject(ST(0))) + } + if (sv_isobject(ST(0))) { Perl_croak(aTHX_ "Cannot change stack size of an existing thread"); + } old_size = default_stack_size; default_stack_size = good_stack_size(aTHX_ SvIV(ST(1))); @@ -1268,8 +1289,9 @@ ithread_is_running(...) ithread *thread; CODE: /* Object method only */ - if (! sv_isobject(ST(0))) + if (! sv_isobject(ST(0))) { Perl_croak(aTHX_ "Usage: $thr->is_running()"); + } thread = INT2PTR(ithread *, SvIV(SvRV(ST(0)))); ST(0) = (thread->state & PERL_ITHR_FINISHED) ? &PL_sv_no : &PL_sv_yes; @@ -1292,8 +1314,9 @@ ithread_is_joinable(...) ithread *thread; CODE: /* Object method only */ - if (! sv_isobject(ST(0))) + if (! sv_isobject(ST(0))) { Perl_croak(aTHX_ "Usage: $thr->is_joinable()"); + } thread = INT2PTR(ithread *, SvIV(SvRV(ST(0)))); MUTEX_LOCK(&thread->mutex); @@ -1321,8 +1344,9 @@ ithread_set_thread_exit_only(...) PREINIT: ithread *thread; CODE: - if (items != 2) + if (items != 2) { Perl_croak(aTHX_ "Usage: ->set_thread_exit_only(boolean)"); + } thread = SV_to_ithread(aTHX_ ST(0)); MUTEX_LOCK(&thread->mutex); if (SvTRUE(ST(1))) {