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 import threads::shared;
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");
36 print("1..74\n"); ### Number of tests that will be run ###
50 # You have to do it this way or VMS will get confused.
52 print("ok $id - $name\n");
54 print("not ok $id - $name\n");
55 printf("# Failed test at line %d\n", (caller)[2]);
62 ### Start of Testing ###
64 # Tests freeing the Perl interperter for each thread
65 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
74 my $tid = threads->tid();
75 ok($tid, "Thread $tid started");
79 my $next = 'th' . ($tid+1);
80 my $th = threads->create($next);
82 # Last thread signals first
90 my $tid = threads->tid();
96 ok($tid, "Thread $tid done");
99 # Wait until signalled by another thread
102 my $tid = threads->tid();
105 while (! exists($READY{$tid})) {
108 my $other = delete($READY{$tid});
109 ok($tid, "Thread $tid received signal from $other");
112 # Signal another thread to go
116 my $tid = threads->tid();
118 ok($tid, "Thread $tid signalling $other");
121 $READY{$other} = $tid;
122 cond_broadcast(%READY);
204 my $ret = threads->object($other)->join();
205 ok($ret == $other, "Thread $other returned $ret");
212 return (threads->tid());
222 my $ret = threads->object($other)->join();
223 ok($ret == $other, "Thread $other returned $ret");
232 return (threads->tid());
244 my $ret = threads->object($other)->join();
245 ok($ret == $other, "Thread $other returned $ret");
252 return (threads->tid());
262 my $ret = threads->object($other)->join();
263 ok($ret == $other, "Thread $other returned $ret");
272 return (threads->tid());
283 threads->create('th1');
286 while ($COUNT < 17) {
293 ok($COUNT == 17, "Done - $COUNT threads");