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 require Thread::Queue;
38 print("1..29\n"); ### Number of tests that will be run ###
41 Test::watchdog(120); # In case we get stuck
43 my $q = Thread::Queue->new();
50 while ($q->pending()) {
51 my $ok = $q->dequeue();
52 my $name = $q->dequeue();
56 print("ok $id - $name\n");
58 print("not ok $id - $name\n");
59 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
71 my ($COUNT, $STARTED) :shared;
76 my $tid = threads->tid();
77 $q->enqueue($tid, "Thread $tid started");
87 threads->create('threading_1', $q)->detach();
105 $q->enqueue($tid, "Thread $tid done");
111 threads->create('threading_1', $q)->detach();
117 cond_wait($COUNT) if ($COUNT < 5);
120 threads->create(sub {
121 threads->create(sub { })->join();
127 ok($COUNT == 5, "Done - $COUNT threads");
133 my $tid = threads->tid();
134 $q->enqueue($tid, "Thread $tid started");
141 threads->create('threading_2', $q)->detach();
149 $q->enqueue($tid, "Thread $tid done");
155 threads->create('threading_2', $q)->detach();
156 threads->create(sub {
157 threads->create(sub { })->join();
167 ok($COUNT == 5, "Done - $COUNT threads");
171 threads->create(sub { })->join();
179 my $tid = threads->tid();
180 $q->enqueue($tid, "Thread $tid started");
183 threads->create(sub {
186 my $tid = threads->tid();
187 $q->enqueue($tid, "Thread $tid started");
195 $q->enqueue($tid, "Thread $tid done");
203 $q->enqueue($tid, "Thread $tid done");
208 threads->create(sub {
209 threads->create('threading_3', $q)->detach();
219 ok($COUNT == 2, "Done - $COUNT threads");