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 threads::shared->import();
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # SKIP threads::shared not available\n");
30 require Thread::Queue;
33 print("1..29\n"); ### Number of tests that will be run ###
37 my $q = Thread::Queue->new();
44 while ($q->pending()) {
45 my $ok = $q->dequeue();
46 my $name = $q->dequeue();
50 print("ok $id - $name\n");
52 print("not ok $id - $name\n");
53 printf("# Failed test at line %d\n", (caller)[2]);
59 ### Start of Testing ###
62 # Tests freeing the Perl interperter for each thread
63 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
65 my ($COUNT, $STARTED) :shared;
70 my $tid = threads->tid();
71 $q->enqueue($tid, "Thread $tid started");
81 threads->create('threading_1', $q)->detach();
99 $q->enqueue($tid, "Thread $tid done");
105 threads->create('threading_1', $q)->detach();
111 cond_wait($COUNT) if ($COUNT < 5);
114 threads->create(sub {
115 threads->create(sub { })->join();
121 ok($COUNT == 5, "Done - $COUNT threads");
127 my $tid = threads->tid();
128 $q->enqueue($tid, "Thread $tid started");
135 threads->create('threading_2', $q)->detach();
143 $q->enqueue($tid, "Thread $tid done");
149 threads->create('threading_2', $q)->detach();
150 threads->create(sub {
151 threads->create(sub { })->join();
161 ok($COUNT == 5, "Done - $COUNT threads");
165 threads->create(sub { })->join();
173 my $tid = threads->tid();
174 $q->enqueue($tid, "Thread $tid started");
177 threads->create(sub {
180 my $tid = threads->tid();
181 $q->enqueue($tid, "Thread $tid started");
189 $q->enqueue($tid, "Thread $tid done");
197 $q->enqueue($tid, "Thread $tid done");
202 threads->create(sub {
203 threads->create('threading_3', $q)->detach();
213 ok($COUNT == 2, "Done - $COUNT threads");