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