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*b39c5158Smillertuse threads; 15*b39c5158Smillert 16*b39c5158SmillertBEGIN { 17*b39c5158Smillert if (! eval 'use threads::shared; 1') { 18*b39c5158Smillert print("1..0 # SKIP threads::shared not available\n"); 19*b39c5158Smillert exit(0); 20*b39c5158Smillert } 21*b39c5158Smillert 22*b39c5158Smillert $| = 1; 23*b39c5158Smillert print("1..59\n"); ### Number of tests that will be run ### 24*b39c5158Smillert}; 25*b39c5158Smillert 26*b39c5158Smillertmy $TEST; 27*b39c5158SmillertBEGIN { 28*b39c5158Smillert share($TEST); 29*b39c5158Smillert $TEST = 1; 30*b39c5158Smillert} 31*b39c5158Smillert 32*b39c5158Smillertok(1, 'Loaded'); 33*b39c5158Smillert 34*b39c5158Smillertsub ok { 35*b39c5158Smillert my ($ok, $name) = @_; 36*b39c5158Smillert 37*b39c5158Smillert lock($TEST); 38*b39c5158Smillert my $id = $TEST++; 39*b39c5158Smillert 40*b39c5158Smillert # You have to do it this way or VMS will get confused. 41*b39c5158Smillert if ($ok) { 42*b39c5158Smillert print("ok $id - $name\n"); 43*b39c5158Smillert } else { 44*b39c5158Smillert print("not ok $id - $name\n"); 45*b39c5158Smillert printf("# Failed test at line %d\n", (caller)[2]); 46*b39c5158Smillert } 47*b39c5158Smillert 48*b39c5158Smillert return ($ok); 49*b39c5158Smillert} 50*b39c5158Smillert 51*b39c5158Smillert 52*b39c5158Smillert### Start of Testing ### 53*b39c5158Smillert 54*b39c5158Smillertmy ($READY, $GO, $DONE) :shared = (0, 0, 0); 55*b39c5158Smillert 56*b39c5158Smillertsub do_thread 57*b39c5158Smillert{ 58*b39c5158Smillert { 59*b39c5158Smillert lock($DONE); 60*b39c5158Smillert $DONE = 0; 61*b39c5158Smillert lock($READY); 62*b39c5158Smillert $READY = 1; 63*b39c5158Smillert cond_signal($READY); 64*b39c5158Smillert } 65*b39c5158Smillert 66*b39c5158Smillert lock($GO); 67*b39c5158Smillert while (! $GO) { 68*b39c5158Smillert cond_wait($GO); 69*b39c5158Smillert } 70*b39c5158Smillert $GO = 0; 71*b39c5158Smillert 72*b39c5158Smillert lock($READY); 73*b39c5158Smillert $READY = 0; 74*b39c5158Smillert lock($DONE); 75*b39c5158Smillert $DONE = 1; 76*b39c5158Smillert cond_signal($DONE); 77*b39c5158Smillert} 78*b39c5158Smillert 79*b39c5158Smillertsub wait_until_ready 80*b39c5158Smillert{ 81*b39c5158Smillert lock($READY); 82*b39c5158Smillert while (! $READY) { 83*b39c5158Smillert cond_wait($READY); 84*b39c5158Smillert } 85*b39c5158Smillert} 86*b39c5158Smillert 87*b39c5158Smillertsub thread_go 88*b39c5158Smillert{ 89*b39c5158Smillert { 90*b39c5158Smillert lock($GO); 91*b39c5158Smillert $GO = 1; 92*b39c5158Smillert cond_signal($GO); 93*b39c5158Smillert } 94*b39c5158Smillert 95*b39c5158Smillert { 96*b39c5158Smillert lock($DONE); 97*b39c5158Smillert while (! $DONE) { 98*b39c5158Smillert cond_wait($DONE); 99*b39c5158Smillert } 100*b39c5158Smillert } 101*b39c5158Smillert threads->yield(); 102*b39c5158Smillert sleep(1); 103*b39c5158Smillert} 104*b39c5158Smillert 105*b39c5158Smillert 106*b39c5158Smillertmy $thr = threads->create('do_thread'); 107*b39c5158Smillertwait_until_ready(); 108*b39c5158Smillertok($thr->is_running(), 'thread running'); 109*b39c5158Smillertok(threads->list(threads::running) == 1, 'thread running list'); 110*b39c5158Smillertok(! $thr->is_detached(), 'thread not detached'); 111*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable'); 112*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list'); 113*b39c5158Smillertok(threads->list(threads::all) == 1, 'thread list'); 114*b39c5158Smillert 115*b39c5158Smillertthread_go(); 116*b39c5158Smillertok(! $thr->is_running(), 'thread not running'); 117*b39c5158Smillertok(threads->list(threads::running) == 0, 'thread running list'); 118*b39c5158Smillertok(! $thr->is_detached(), 'thread not detached'); 119*b39c5158Smillertok($thr->is_joinable(), 'thread joinable'); 120*b39c5158Smillertok(threads->list(threads::joinable) == 1, 'thread joinable list'); 121*b39c5158Smillertok(threads->list(threads::all) == 1, 'thread list'); 122*b39c5158Smillert 123*b39c5158Smillert$thr->join(); 124*b39c5158Smillertok(! $thr->is_running(), 'thread not running'); 125*b39c5158Smillertok(threads->list(threads::running) == 0, 'thread running list'); 126*b39c5158Smillertok(! $thr->is_detached(), 'thread not detached'); 127*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable'); 128*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list'); 129*b39c5158Smillertok(threads->list(threads::all) == 0, 'thread list'); 130*b39c5158Smillert 131*b39c5158Smillert$thr = threads->create('do_thread'); 132*b39c5158Smillert$thr->detach(); 133*b39c5158Smillertok($thr->is_running(), 'thread running'); 134*b39c5158Smillertok(threads->list(threads::running) == 0, 'thread running list'); 135*b39c5158Smillertok($thr->is_detached(), 'thread detached'); 136*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable'); 137*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list'); 138*b39c5158Smillertok(threads->list(threads::all) == 0, 'thread list'); 139*b39c5158Smillert 140*b39c5158Smillertthread_go(); 141*b39c5158Smillertok(! $thr->is_running(), 'thread not running'); 142*b39c5158Smillertok(threads->list(threads::running) == 0, 'thread running list'); 143*b39c5158Smillertok($thr->is_detached(), 'thread detached'); 144*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable'); 145*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list'); 146*b39c5158Smillert 147*b39c5158Smillert$thr = threads->create(sub { 148*b39c5158Smillert ok(! threads->is_detached(), 'thread not detached'); 149*b39c5158Smillert ok(threads->list(threads::running) == 1, 'thread running list'); 150*b39c5158Smillert ok(threads->list(threads::joinable) == 0, 'thread joinable list'); 151*b39c5158Smillert ok(threads->list(threads::all) == 1, 'thread list'); 152*b39c5158Smillert threads->detach(); 153*b39c5158Smillert do_thread(); 154*b39c5158Smillert ok(threads->is_detached(), 'thread detached'); 155*b39c5158Smillert ok(threads->list(threads::running) == 0, 'thread running list'); 156*b39c5158Smillert ok(threads->list(threads::joinable) == 0, 'thread joinable list'); 157*b39c5158Smillert ok(threads->list(threads::all) == 0, 'thread list'); 158*b39c5158Smillert}); 159*b39c5158Smillert 160*b39c5158Smillertwait_until_ready(); 161*b39c5158Smillertok($thr->is_running(), 'thread running'); 162*b39c5158Smillertok(threads->list(threads::running) == 0, 'thread running list'); 163*b39c5158Smillertok($thr->is_detached(), 'thread detached'); 164*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable'); 165*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list'); 166*b39c5158Smillertok(threads->list(threads::all) == 0, 'thread list'); 167*b39c5158Smillert 168*b39c5158Smillertthread_go(); 169*b39c5158Smillertok(! $thr->is_running(), 'thread not running'); 170*b39c5158Smillertok(threads->list(threads::running) == 0, 'thread running list'); 171*b39c5158Smillertok($thr->is_detached(), 'thread detached'); 172*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable'); 173*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list'); 174*b39c5158Smillert 175*b39c5158Smillert{ 176*b39c5158Smillert my $go : shared = 0; 177*b39c5158Smillert my $t = threads->create( sub { 178*b39c5158Smillert ok(! threads->is_detached(), 'thread not detached'); 179*b39c5158Smillert ok(threads->list(threads::running) == 1, 'thread running list'); 180*b39c5158Smillert ok(threads->list(threads::joinable) == 0, 'thread joinable list'); 181*b39c5158Smillert ok(threads->list(threads::all) == 1, 'thread list'); 182*b39c5158Smillert lock($go); $go = 1; cond_signal($go); 183*b39c5158Smillert }); 184*b39c5158Smillert 185*b39c5158Smillert { lock ($go); cond_wait($go) until $go; } 186*b39c5158Smillert $t->join; 187*b39c5158Smillert} 188*b39c5158Smillert 189*b39c5158Smillert{ 190*b39c5158Smillert my $rdy :shared = 0; 191*b39c5158Smillert sub thr_ready 192*b39c5158Smillert { 193*b39c5158Smillert lock($rdy); 194*b39c5158Smillert $rdy++; 195*b39c5158Smillert cond_signal($rdy); 196*b39c5158Smillert } 197*b39c5158Smillert 198*b39c5158Smillert my $go :shared = 0; 199*b39c5158Smillert sub thr_wait 200*b39c5158Smillert { 201*b39c5158Smillert lock($go); 202*b39c5158Smillert cond_wait($go) until $go; 203*b39c5158Smillert } 204*b39c5158Smillert 205*b39c5158Smillert my $done :shared = 0; 206*b39c5158Smillert sub thr_done 207*b39c5158Smillert { 208*b39c5158Smillert lock($done); 209*b39c5158Smillert $done++; 210*b39c5158Smillert cond_signal($done); 211*b39c5158Smillert } 212*b39c5158Smillert 213*b39c5158Smillert my $thr_routine = sub { thr_ready(); thr_wait(); thr_done(); }; 214*b39c5158Smillert 215*b39c5158Smillert # Create 8 threads: 216*b39c5158Smillert # 3 running, blocking on $go 217*b39c5158Smillert # 2 running, blocking on $go, join pending 218*b39c5158Smillert # 2 running, blocking on join of above 219*b39c5158Smillert # 1 finished, unjoined 220*b39c5158Smillert 221*b39c5158Smillert for (1..3) { threads->create($thr_routine); } 222*b39c5158Smillert 223*b39c5158Smillert foreach my $t (map {threads->create($thr_routine)} 1..2) { 224*b39c5158Smillert threads->create(sub { thr_ready(); $_[0]->join; thr_done(); }, $t); 225*b39c5158Smillert } 226*b39c5158Smillert threads->create(sub { thr_ready(); thr_done(); }); 227*b39c5158Smillert { 228*b39c5158Smillert lock($done); 229*b39c5158Smillert cond_wait($done) until ($done == 1); 230*b39c5158Smillert } 231*b39c5158Smillert { 232*b39c5158Smillert lock($rdy); 233*b39c5158Smillert cond_wait($rdy) until ($rdy == 8); 234*b39c5158Smillert } 235*b39c5158Smillert threads->yield(); 236*b39c5158Smillert sleep(1); 237*b39c5158Smillert 238*b39c5158Smillert ok(threads->list(threads::running) == 5, 'thread running list'); 239*b39c5158Smillert ok(threads->list(threads::joinable) == 1, 'thread joinable list'); 240*b39c5158Smillert ok(threads->list(threads::all) == 6, 'thread all list'); 241*b39c5158Smillert 242*b39c5158Smillert { lock($go); $go = 1; cond_broadcast($go); } 243*b39c5158Smillert { 244*b39c5158Smillert lock($done); 245*b39c5158Smillert cond_wait($done) until ($done == 8); 246*b39c5158Smillert } 247*b39c5158Smillert threads->yield(); 248*b39c5158Smillert sleep(1); 249*b39c5158Smillert 250*b39c5158Smillert ok(threads->list(threads::running) == 0, 'thread running list'); 251*b39c5158Smillert # Two awaiting join() have completed 252*b39c5158Smillert ok(threads->list(threads::joinable) == 6, 'thread joinable list'); 253*b39c5158Smillert ok(threads->list(threads::all) == 6, 'thread all list'); 254*b39c5158Smillert 255*b39c5158Smillert for (threads->list) { $_->join; } 256*b39c5158Smillert} 257*b39c5158Smillert 258*b39c5158Smillertexit(0); 259*b39c5158Smillert 260*b39c5158Smillert# EOF 261