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;
19 my ($id, $ok, $name) = @_;
21 # You have to do it this way or VMS will get confused.
23 print("ok $id - $name\n");
25 print("not ok $id - $name\n");
26 printf("# Failed test at line %d\n", (caller)[2]);
34 print("1..29\n"); ### Number of tests that will be run ###
41 ### Start of Testing ###
43 # Tests freeing the Perl interperter for each thread
44 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
52 my $tid = threads->tid();
53 ok($TEST++, $tid, "Thread $tid started");
57 threads->create('threading_1')->detach();
77 ok($TEST++, $tid, "Thread $tid done");
82 threads->create('threading_1')->detach();
100 ok($TEST++, $COUNT == 5, "Done - $COUNT threads");
104 my $tid = threads->tid();
105 ok($TEST++, $tid, "Thread $tid started");
108 threads->create('threading_2')->detach();
117 ok($TEST++, $tid, "Thread $tid done");
122 threads->create('threading_2')->detach();
132 ok($TEST++, $COUNT == 5, "Done - $COUNT threads");
136 threads->create(sub { })->join();
138 ok($TEST++, 1, 'Join');
142 my $tid = threads->tid();
143 ok($TEST++, $tid, "Thread $tid started");
146 threads->create(sub {
147 my $tid = threads->tid();
148 ok($TEST++, $tid, "Thread $tid started");
157 ok($TEST++, $tid, "Thread $tid done");
165 ok($TEST++, $tid, "Thread $tid done");
170 threads->create(sub {
171 threads->create('threading_3')->detach();
182 ok($TEST++, $COUNT == 2, "Done - $COUNT threads");