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 ###
53 # You have to do it this way or VMS will get confused.
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 ###
67 # Tests freeing the Perl interperter for each thread
68 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
77 my $tid = threads->tid();
78 ok($tid, "Thread $tid started");
82 my $next = 'th' . ($tid+1);
83 my $th = threads->create($next);
85 # Last thread signals first
93 my $tid = threads->tid();
99 ok($tid, "Thread $tid done");
102 # Wait until signalled by another thread
105 my $tid = threads->tid();
108 while (! exists($READY{$tid})) {
111 my $other = delete($READY{$tid});
112 ok($tid, "Thread $tid received signal from $other");
115 # Signal another thread to go
119 my $tid = threads->tid();
121 ok($tid, "Thread $tid signalling $other");
124 $READY{$other} = $tid;
125 cond_broadcast(%READY);
207 my $ret = threads->object($other)->join();
208 ok($ret == $other, "Thread $other returned $ret");
215 return (threads->tid());
225 my $ret = threads->object($other)->join();
226 ok($ret == $other, "Thread $other returned $ret");
235 return (threads->tid());
247 my $ret = threads->object($other)->join();
248 ok($ret == $other, "Thread $other returned $ret");
255 return (threads->tid());
265 my $ret = threads->object($other)->join();
266 ok($ret == $other, "Thread $other returned $ret");
275 return (threads->tid());
286 threads->create('th1');
289 while ($COUNT < 17) {
296 ok($COUNT == 17, "Done - $COUNT threads");