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 if (($] < 5.008002) && ($threads::shared::VERSION < 0.92)) {
23 print("1..0 # Skip: Needs threads::shared 0.92 or later\n");
28 print("1..74\n"); ### Number of tests that will be run ###
42 # You have to do it this way or VMS will get confused.
44 print("ok $id - $name\n");
46 print("not ok $id - $name\n");
47 printf("# Failed test at line %d\n", (caller)[2]);
54 ### Start of Testing ###
56 # Tests freeing the Perl interperter for each thread
57 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
66 my $tid = threads->tid();
67 ok($tid, "Thread $tid started");
71 my $next = 'th' . ($tid+1);
72 my $th = threads->create($next);
74 # Last thread signals first
82 my $tid = threads->tid();
88 ok($tid, "Thread $tid done");
91 # Wait until signalled by another thread
94 my $tid = threads->tid();
97 while (! exists($READY{$tid})) {
100 my $other = delete($READY{$tid});
101 ok($tid, "Thread $tid received signal from $other");
104 # Signal another thread to go
108 my $tid = threads->tid();
110 ok($tid, "Thread $tid signalling $other");
113 $READY{$other} = $tid;
114 cond_broadcast(%READY);
196 my $ret = threads->object($other)->join();
197 ok($ret == $other, "Thread $other returned $ret");
204 return (threads->tid());
214 my $ret = threads->object($other)->join();
215 ok($ret == $other, "Thread $other returned $ret");
224 return (threads->tid());
236 my $ret = threads->object($other)->join();
237 ok($ret == $other, "Thread $other returned $ret");
244 return (threads->tid());
254 my $ret = threads->object($other)->join();
255 ok($ret == $other, "Thread $other returned $ret");
264 return (threads->tid());
275 threads->create('th1');
278 while ($COUNT < 17) {
285 ok($COUNT == 17, "Done - $COUNT threads");