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;
27 if (! eval 'use threads::shared; 1') {
28 Test::skip_all(q/threads::shared not available/);
31 require Thread::Queue;
34 print("1..29\n"); ### Number of tests that will be run ###
37 Test::watchdog(120); # In case we get stuck
39 my $q = Thread::Queue->new();
46 while ($q->pending()) {
47 my $ok = $q->dequeue();
48 my $name = $q->dequeue();
52 print("ok $id - $name\n");
54 print("not ok $id - $name\n");
55 printf("# Failed test at line %d\n", (caller)[2]);
61 ### 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
67 my ($COUNT, $STARTED) :shared;
72 my $tid = threads->tid();
73 $q->enqueue($tid, "Thread $tid started");
83 threads->create('threading_1', $q)->detach();
101 $q->enqueue($tid, "Thread $tid done");
107 threads->create('threading_1', $q)->detach();
113 cond_wait($COUNT) if ($COUNT < 5);
116 threads->create(sub {
117 threads->create(sub { })->join();
123 ok($COUNT == 5, "Done - $COUNT threads");
129 my $tid = threads->tid();
130 $q->enqueue($tid, "Thread $tid started");
137 threads->create('threading_2', $q)->detach();
145 $q->enqueue($tid, "Thread $tid done");
151 threads->create('threading_2', $q)->detach();
152 threads->create(sub {
153 threads->create(sub { })->join();
163 ok($COUNT == 5, "Done - $COUNT threads");
167 threads->create(sub { })->join();
175 my $tid = threads->tid();
176 $q->enqueue($tid, "Thread $tid started");
179 threads->create(sub {
182 my $tid = threads->tid();
183 $q->enqueue($tid, "Thread $tid started");
191 $q->enqueue($tid, "Thread $tid done");
199 $q->enqueue($tid, "Thread $tid done");
204 threads->create(sub {
205 threads->create('threading_3', $q)->detach();
215 ok($COUNT == 2, "Done - $COUNT threads");