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
-threads version 1.37
+threads version 1.38
====================
This module exposes interpreter threads to the Perl level.
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);
$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");
if ($STARTED < 5) {
threads->create('threading_2')->detach();
}
-
threads->yield();
lock($COUNT);
cond_wait($COUNT);
}
}
- threads->yield();
sleep(1);
}
ok($COUNT == 5, "Done - $COUNT threads");
my $tid = threads->tid();
ok($tid, "Thread $tid started");
- threads->yield();
sleep(1);
lock($COUNT);
cond_signal($COUNT);
ok($tid, "Thread $tid done");
- })->join();
+ })->detach();
}
lock($COUNT);
}
}
})->join();
- threads->yield();
sleep(1);
}
ok($COUNT == 2, "Done - $COUNT threads");
}
$| = 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;
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
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
{
}
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();
}
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());
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();
}
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;
cond_wait($COUNT);
}
}
- threads->yield();
sleep(1);
}
ok($COUNT == 17, "Done - $COUNT threads");
# 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,
use strict;
use warnings;
-our $VERSION = '1.37';
+our $VERSION = '1.38';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
=head1 VERSION
-This document describes threads version 1.37
+This document describes threads version 1.38
=head1 SYNOPSIS
L<http://www.cpanforum.com/dist/threads>
Annotated POD for L<threads>:
-L<http://annocpan.org/~JDHEDDEN/threads-1.37/threads.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.38/threads.pm>
L<threads::shared>, L<perlthrtut>
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
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);
}
}
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;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff