From: Jerry D. Hedden Date: Tue, 1 Aug 2006 08:58:52 +0000 (-0700) Subject: threads 1.38 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d4315dd6a064c0701c6a2be9857472687268433f;p=p5sagit%2Fp5-mst-13.2.git threads 1.38 From: "Jerry D. Hedden" Message-ID: <20060801085852.fb30e530d17747c2b054d625b8945d88.ad7fb0a136.wbe@email.secureserver.net> p4raw-id: //depot/perl@28642 --- diff --git a/ext/threads/Changes b/ext/threads/Changes index 34cff5e..e2f405a 100755 --- a/ext/threads/Changes +++ b/ext/threads/Changes @@ -1,5 +1,8 @@ Revision history for Perl extension threads. +1.38 Tue Aug 1 11:48:56 EDT 2006 + - Fixes to tests + 1.37 Fri Jul 21 10:51:36 EDT 2006 - Revert 'exit' behavior with override diff --git a/ext/threads/README b/ext/threads/README index 03f5fb9..66fe5ec 100755 --- a/ext/threads/README +++ b/ext/threads/README @@ -1,4 +1,4 @@ -threads version 1.37 +threads version 1.38 ==================== This module exposes interpreter threads to the Perl level. diff --git a/ext/threads/t/free.t b/ext/threads/t/free.t index 3dfc4a1..44ef1cb 100644 --- a/ext/threads/t/free.t +++ b/ext/threads/t/free.t @@ -68,24 +68,24 @@ sub threading_1 { my $tid = threads->tid(); ok($tid, "Thread $tid started"); + my $id; { lock($STARTED); $STARTED++; + $id = $STARTED; } if ($STARTED < 5) { sleep(1); threads->create('threading_1')->detach(); } - threads->yield(); - - if ($tid == 1) { + if ($id == 1) { sleep(2); - } elsif ($tid == 2) { + } elsif ($id == 2) { sleep(6); - } elsif ($tid == 3) { + } elsif ($id == 3) { sleep(3); - } elsif ($tid == 4) { + } elsif ($id == 4) { sleep(1); } else { sleep(2); @@ -102,26 +102,18 @@ sub threading_1 { $COUNT = 0; threads->create('threading_1')->detach(); { - lock($COUNT); - while ($COUNT < 3) { - cond_wait($COUNT); - threads->create(sub { - threads->create(sub { })->join(); - })->join(); - } - } -} -{ - { - lock($COUNT); - while ($COUNT < 5) { - cond_wait($COUNT); + my $cnt = 0; + while ($cnt < 5) { + { + lock($COUNT); + cond_wait($COUNT) if ($COUNT < 5); + $cnt = $COUNT; + } threads->create(sub { threads->create(sub { })->join(); })->join(); } } - threads->yield(); sleep(1); } ok($COUNT == 5, "Done - $COUNT threads"); @@ -138,7 +130,6 @@ sub threading_2 { if ($STARTED < 5) { threads->create('threading_2')->detach(); } - threads->yield(); lock($COUNT); @@ -161,7 +152,6 @@ sub threading_2 { cond_wait($COUNT); } } - threads->yield(); sleep(1); } ok($COUNT == 5, "Done - $COUNT threads"); @@ -182,7 +172,6 @@ sub threading_3 { my $tid = threads->tid(); ok($tid, "Thread $tid started"); - threads->yield(); sleep(1); lock($COUNT); @@ -190,7 +179,7 @@ sub threading_3 { cond_signal($COUNT); ok($tid, "Thread $tid done"); - })->join(); + })->detach(); } lock($COUNT); @@ -211,7 +200,6 @@ sub threading_3 { } } })->join(); - threads->yield(); sleep(1); } ok($COUNT == 2, "Done - $COUNT threads"); diff --git a/ext/threads/t/free2.t b/ext/threads/t/free2.t index eb33da1..cdab3eb 100644 --- a/ext/threads/t/free2.t +++ b/ext/threads/t/free2.t @@ -33,7 +33,7 @@ BEGIN { } $| = 1; - print("1..74\n"); ### Number of tests that will be run ### + print("1..78\n"); ### Number of tests that will be run ### }; my $TEST; @@ -77,15 +77,29 @@ sub th_start { my $tid = threads->tid(); ok($tid, "Thread $tid started"); - # Create next thread - if ($tid < 17) { - my $next = 'th' . ($tid+1); - my $th = threads->create($next); - } else { - # Last thread signals first - th_signal(1); + threads->yield(); + + my $other; + { + lock(%READY); + + # Create next thread + if ($tid < 17) { + my $next = 'th' . ($tid+1); + my $th = threads->create($next); + } else { + # Last thread signals first + th_signal(1); + } + + # Wait until signalled by another thread + while (! exists($READY{$tid})) { + cond_wait(%READY); + } + $other = delete($READY{$tid}); } - th_wait(); + ok($tid, "Thread $tid received signal from $other"); + threads->yield(); } # Thread terminating @@ -99,19 +113,6 @@ sub th_done { ok($tid, "Thread $tid done"); } -# Wait until signalled by another thread -sub th_wait -{ - my $tid = threads->tid(); - - lock(%READY); - while (! exists($READY{$tid})) { - cond_wait(%READY); - } - my $other = delete($READY{$tid}); - ok($tid, "Thread $tid received signal from $other"); -} - # Signal another thread to go sub th_signal { @@ -197,15 +198,16 @@ sub th16 { } sub th3 { + my $tid = threads->tid(); my $other = 5; th_start(); threads->detach(); th_signal($other); - threads->yield(); sleep(1); + ok(1, "Thread $tid getting return from thread $other"); my $ret = threads->object($other)->join(); - ok($ret == $other, "Thread $other returned $ret"); + ok($ret == $other, "Thread $tid saw that thread $other returned $ret"); th_done(); } @@ -217,19 +219,20 @@ sub th5 { sub th7 { + my $tid = threads->tid(); my $other = 9; th_start(); threads->detach(); th_signal($other); + ok(1, "Thread $tid getting return from thread $other"); my $ret = threads->object($other)->join(); - ok($ret == $other, "Thread $other returned $ret"); + ok($ret == $other, "Thread $tid saw that thread $other returned $ret"); th_done(); } sub th9 { th_start(); - threads->yield(); sleep(1); th_done(); return (threads->tid()); @@ -237,15 +240,16 @@ sub th9 { sub th13 { + my $tid = threads->tid(); my $other = 11; th_start(); threads->detach(); th_signal($other); - threads->yield(); sleep(1); + ok(1, "Thread $tid getting return from thread $other"); my $ret = threads->object($other)->join(); - ok($ret == $other, "Thread $other returned $ret"); + ok($ret == $other, "Thread $tid saw that thread $other returned $ret"); th_done(); } @@ -257,29 +261,26 @@ sub th11 { sub th17 { + my $tid = threads->tid(); my $other = 15; th_start(); threads->detach(); th_signal($other); + ok(1, "Thread $tid getting return from thread $other"); my $ret = threads->object($other)->join(); - ok($ret == $other, "Thread $other returned $ret"); + ok($ret == $other, "Thread $tid saw that thread $other returned $ret"); th_done(); } sub th15 { th_start(); - threads->yield(); sleep(1); th_done(); return (threads->tid()); } - - - - TEST_STARTS_HERE: { $COUNT = 0; @@ -290,7 +291,6 @@ TEST_STARTS_HERE: cond_wait($COUNT); } } - threads->yield(); sleep(1); } ok($COUNT == 17, "Done - $COUNT threads"); diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t index 5fb2425..6fab98e 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.37;' . +run_perl(prog => 'use threads 1.38;' . '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 6564359..2970321 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.37'; +our $VERSION = '1.38'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -129,7 +129,7 @@ threads - Perl interpreter-based threads =head1 VERSION -This document describes threads version 1.37 +This document describes threads version 1.38 =head1 SYNOPSIS @@ -887,7 +887,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 2765589..a95aff8 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -620,12 +620,12 @@ S_ithread_create( clone_param.flags = 0; thread->init_function = sv_dup(init_function, &clone_param); if (SvREFCNT(thread->init_function) == 0) { - SvREFCNT_inc(thread->init_function); + SvREFCNT_inc_void(thread->init_function); } } thread->params = sv_dup(params, &clone_param); - SvREFCNT_inc(thread->params); + SvREFCNT_inc_void(thread->params); /* The code below checks that anything living on the tmps stack and * has been cloned (so it lives in the ptr_table) has a refcount @@ -645,7 +645,7 @@ S_ithread_create( SV* sv = (SV*)ptr_table_fetch(PL_ptr_table, tmps_tmp[tmps_ix]); tmps_ix--; if (sv && SvREFCNT(sv) == 0) { - SvREFCNT_inc(sv); + SvREFCNT_inc_void(sv); SvREFCNT_dec(sv); } } @@ -1029,7 +1029,7 @@ ithread_join(...) params = (AV *)sv_dup((SV*)params_copy, &clone_params); S_ithread_set(aTHX_ current_thread); SvREFCNT_dec(clone_params.stashes); - SvREFCNT_inc(params); + SvREFCNT_inc_void(params); ptr_table_free(PL_ptr_table); PL_ptr_table = NULL; }