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