5 if ($ENV{'PERL_CORE'}){
7 unshift @INC, '../lib';
10 if (! $Config{'useithreads'}) {
11 print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
16 use ExtUtils::testlib;
22 require threads::shared;
23 threads::shared->import();
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # Skip: threads::shared not available\n");
30 if (($] < 5.008002) && ($threads::shared::VERSION < 0.92)) {
31 print("1..0 # Skip: Needs threads::shared 0.92 or later\n");
35 require Thread::Queue;
38 print("1..78\n"); ### Number of tests that will be run ###
42 my $q = Thread::Queue->new();
47 $q->enqueue(@_) if @_;
49 while ($q->pending()) {
50 my $ok = $q->dequeue();
51 my $name = $q->dequeue();
55 print("ok $id - $name\n");
57 print("not ok $id - $name\n");
58 printf("# Failed test at line %d\n", (caller)[2]);
65 ### Start of Testing ###
68 # Tests freeing the Perl interperter for each thread
69 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
80 my $tid = threads->tid();
81 $q->enqueue($tid, "Thread $tid started");
91 my $next = 'th' . ($tid+1);
92 my $th = threads->create($next, $q);
94 # Last thread signals first
98 # Wait until signalled by another thread
99 while (! exists($READY{$tid})) {
102 $other = delete($READY{$tid});
104 $q->enqueue($tid, "Thread $tid received signal from $other");
112 my $tid = threads->tid();
118 $q->enqueue($tid, "Thread $tid done");
121 # Signal another thread to go
126 my $tid = threads->tid();
128 $q->enqueue($tid, "Thread $tid signalling $other");
131 $READY{$other} = $tid;
132 cond_broadcast(%READY);
227 my $tid = threads->tid();
232 th_signal($q, $other);
234 $q->enqueue(1, "Thread $tid getting return from thread $other");
235 my $ret = threads->object($other)->join();
236 $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
245 return (threads->tid());
252 my $tid = threads->tid();
257 th_signal($q, $other);
258 $q->enqueue(1, "Thread $tid getting return from thread $other");
259 my $ret = threads->object($other)->join();
260 $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
270 return (threads->tid());
277 my $tid = threads->tid();
282 th_signal($q, $other);
284 $q->enqueue(1, "Thread $tid getting return from thread $other");
285 my $ret = threads->object($other)->join();
286 $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
295 return (threads->tid());
302 my $tid = threads->tid();
307 th_signal($q, $other);
308 $q->enqueue(1, "Thread $tid getting return from thread $other");
309 my $ret = threads->object($other)->join();
310 $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
320 return (threads->tid());
327 threads->create('th1', $q);
330 while ($COUNT < 17) {
332 ok(); # Prints out any intermediate results
337 ok($COUNT == 17, "Done - $COUNT threads");