1use strict; 2use warnings; 3 4BEGIN { 5 use Config; 6 if (! $Config{'useithreads'}) { 7 print("1..0 # SKIP Perl not compiled with 'useithreads'\n"); 8 exit(0); 9 } 10} 11 12use ExtUtils::testlib; 13 14sub ok { 15 my ($id, $ok, $name) = @_; 16 17 # You have to do it this way or VMS will get confused. 18 if ($ok) { 19 print("ok $id - $name\n"); 20 } else { 21 print("not ok $id - $name\n"); 22 printf("# Failed test at line %d\n", (caller)[2]); 23 } 24 25 return ($ok); 26} 27 28BEGIN { 29 $| = 1; 30 print("1..15\n"); ### Number of tests that will be run ### 31}; 32 33use threads; 34ok(1, 1, 'Loaded'); 35 36### Start of Testing ### 37 38ok(2, scalar @{[threads->list()]} == 0, 'No threads yet'); 39 40threads->create(sub {})->join(); 41ok(3, scalar @{[threads->list()]} == 0, 'Empty thread list after join'); 42 43my $thread = threads->create(sub {}); 44ok(4, scalar(threads->list()) == 1, 'Non-empty thread list'); 45ok(5, threads->list() == 1, 'Non-empty thread list'); 46$thread->join(); 47ok(6, scalar @{[threads->list()]} == 0, 'Thread list empty again'); 48ok(7, threads->list() == 0, 'Thread list empty again'); 49 50$thread = threads->create(sub { 51 ok(8, threads->list() == 1, 'Non-empty thread list in thread'); 52 ok(9, threads->self == (threads->list())[0], 'Self in thread list') 53}); 54 55threads->yield; # help out non-preemptive thread implementations 56sleep 1; 57 58ok(10, scalar(threads->list()) == 1, 'Thread count 1'); 59ok(11, threads->list() == 1, 'Thread count 1'); 60my $cnt = threads->list(); 61ok(12, $cnt == 1, 'Thread count 1'); 62my ($thr_x) = threads->list(); 63ok(13, $thread == $thr_x, 'Thread in list'); 64$thread->join(); 65ok(14, scalar @{[threads->list()]} == 0, 'Thread list empty'); 66ok(15, threads->list() == 0, 'Thread list empty'); 67 68exit(0); 69 70# EOF 71