5 if ($ENV{'PERL_CORE'}){
7 unshift @INC, '../lib';
10 # Import test.pl into its own package
13 require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl');
17 if (! $Config{'useithreads'}) {
18 Test::skip_all(q/Perl not compiled with 'useithreads'/);
22 use ExtUtils::testlib;
28 require threads::shared;
29 threads::shared->import();
31 if ($@ || ! $threads::shared::threads_shared) {
32 Test::skip_all(q/threads::shared not available/);
35 if (($] < 5.008002) && ($threads::shared::VERSION < 0.92)) {
36 Test::skip_all(q/Needs threads::shared 0.92 or later/);
39 require Thread::Queue;
42 print("1..78\n"); ### Number of tests that will be run ###
45 Test::watchdog(60); # In case we get stuck
47 my $q = Thread::Queue->new();
52 $q->enqueue(@_) if @_;
54 while ($q->pending()) {
55 my $ok = $q->dequeue();
56 my $name = $q->dequeue();
60 print("ok $id - $name\n");
62 print("not ok $id - $name\n");
63 printf("# Failed test at line %d\n", (caller)[2]);
70 ### Start of Testing ###
73 # Tests freeing the Perl interperter for each thread
74 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
85 my $tid = threads->tid();
86 $q->enqueue($tid, "Thread $tid started");
96 my $next = 'th' . $tid;
97 my $th = threads->create($next, $q);
99 # Last thread signals first
103 # Wait until signalled by another thread
104 while (! exists($READY{$tid})) {
107 $other = delete($READY{$tid});
109 $q->enqueue($tid, "Thread $tid received signal from $other");
117 my $tid = threads->tid();
123 $q->enqueue($tid, "Thread $tid done");
126 # Signal another thread to go
132 my $tid = threads->tid();
134 $q->enqueue($tid, "Thread $tid signalling $other");
137 $READY{$other} = $tid;
138 cond_broadcast(%READY);
233 my $tid = threads->tid();
238 th_signal($q, $other);
240 $q->enqueue(1, "Thread $tid getting return from thread $other");
241 my $ret = threads->object($other+1)->join();
242 $q->enqueue($ret == $other+1, "Thread $tid saw that thread $other returned $ret");
251 return (threads->tid());
258 my $tid = threads->tid();
263 th_signal($q, $other);
264 $q->enqueue(1, "Thread $tid getting return from thread $other");
265 my $ret = threads->object($other+1)->join();
266 $q->enqueue($ret == $other+1, "Thread $tid saw that thread $other returned $ret");
276 return (threads->tid());
283 my $tid = threads->tid();
288 th_signal($q, $other);
290 $q->enqueue(1, "Thread $tid getting return from thread $other");
291 my $ret = threads->object($other+1)->join();
292 $q->enqueue($ret == $other+1, "Thread $tid saw that thread $other returned $ret");
301 return (threads->tid());
308 my $tid = threads->tid();
313 th_signal($q, $other);
314 $q->enqueue(1, "Thread $tid getting return from thread $other");
315 my $ret = threads->object($other+1)->join();
316 $q->enqueue($ret == $other+1, "Thread $tid saw that thread $other returned $ret");
326 return (threads->tid());
333 threads->create('th1', $q);
336 while ($COUNT < 17) {
338 ok(); # Prints out any intermediate results
343 ok($COUNT == 17, "Done - $COUNT threads");