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;
22 require threads::shared;
23 threads::shared->import();
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # SKIP threads::shared not available\n");
31 print("1..59\n"); ### Number of tests that will be run ###
48 # You have to do it this way or VMS will get confused.
50 print("ok $id - $name\n");
52 print("not ok $id - $name\n");
53 printf("# Failed test at line %d\n", (caller)[2]);
60 ### Start of Testing ###
62 my ($READY, $GO, $DONE) :shared = (0, 0, 0);
114 my $thr = threads->create('do_thread');
116 ok($thr->is_running(), 'thread running');
117 ok(threads->list(threads::running) == 1, 'thread running list');
118 ok(! $thr->is_detached(), 'thread not detached');
119 ok(! $thr->is_joinable(), 'thread not joinable');
120 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
121 ok(threads->list(threads::all) == 1, 'thread list');
124 ok(! $thr->is_running(), 'thread not running');
125 ok(threads->list(threads::running) == 0, 'thread running list');
126 ok(! $thr->is_detached(), 'thread not detached');
127 ok($thr->is_joinable(), 'thread joinable');
128 ok(threads->list(threads::joinable) == 1, 'thread joinable list');
129 ok(threads->list(threads::all) == 1, 'thread list');
132 ok(! $thr->is_running(), 'thread not running');
133 ok(threads->list(threads::running) == 0, 'thread running list');
134 ok(! $thr->is_detached(), 'thread not detached');
135 ok(! $thr->is_joinable(), 'thread not joinable');
136 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
137 ok(threads->list(threads::all) == 0, 'thread list');
139 $thr = threads->create('do_thread');
141 ok($thr->is_running(), 'thread running');
142 ok(threads->list(threads::running) == 0, 'thread running list');
143 ok($thr->is_detached(), 'thread detached');
144 ok(! $thr->is_joinable(), 'thread not joinable');
145 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
146 ok(threads->list(threads::all) == 0, 'thread list');
149 ok(! $thr->is_running(), 'thread not running');
150 ok(threads->list(threads::running) == 0, 'thread running list');
151 ok($thr->is_detached(), 'thread detached');
152 ok(! $thr->is_joinable(), 'thread not joinable');
153 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
155 $thr = threads->create(sub {
156 ok(! threads->is_detached(), 'thread not detached');
157 ok(threads->list(threads::running) == 1, 'thread running list');
158 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
159 ok(threads->list(threads::all) == 1, 'thread list');
162 ok(threads->is_detached(), 'thread detached');
163 ok(threads->list(threads::running) == 0, 'thread running list');
164 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
165 ok(threads->list(threads::all) == 0, 'thread list');
169 ok($thr->is_running(), 'thread running');
170 ok(threads->list(threads::running) == 0, 'thread running list');
171 ok($thr->is_detached(), 'thread detached');
172 ok(! $thr->is_joinable(), 'thread not joinable');
173 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
174 ok(threads->list(threads::all) == 0, 'thread list');
177 ok(! $thr->is_running(), 'thread not running');
178 ok(threads->list(threads::running) == 0, 'thread running list');
179 ok($thr->is_detached(), 'thread detached');
180 ok(! $thr->is_joinable(), 'thread not joinable');
181 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
185 my $t = threads->create( sub {
186 ok(! threads->is_detached(), 'thread not detached');
187 ok(threads->list(threads::running) == 1, 'thread running list');
188 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
189 ok(threads->list(threads::all) == 1, 'thread list');
190 lock($go); $go = 1; cond_signal($go);
193 { lock ($go); cond_wait($go) until $go; }
210 cond_wait($go) until $go;
213 my $done :shared = 0;
221 my $thr_routine = sub { thr_ready(); thr_wait(); thr_done(); };
224 # 3 running, blocking on $go
225 # 2 running, blocking on $go, join pending
226 # 2 running, blocking on join of above
227 # 1 finished, unjoined
229 for (1..3) { threads->create($thr_routine); }
231 foreach my $t (map {threads->create($thr_routine)} 1..2) {
232 threads->create(sub { thr_ready(); $_[0]->join; thr_done(); }, $t);
234 threads->create(sub { thr_ready(); thr_done(); });
237 cond_wait($done) until ($done == 1);
241 cond_wait($rdy) until ($rdy == 8);
246 ok(threads->list(threads::running) == 5, 'thread running list');
247 ok(threads->list(threads::joinable) == 1, 'thread joinable list');
248 ok(threads->list(threads::all) == 6, 'thread all list');
250 { lock($go); $go = 1; cond_broadcast($go); }
253 cond_wait($done) until ($done == 8);
258 ok(threads->list(threads::running) == 0, 'thread running list');
259 # Two awaiting join() have completed
260 ok(threads->list(threads::joinable) == 6, 'thread joinable list');
261 ok(threads->list(threads::all) == 6, 'thread all list');
263 for (threads->list) { $_->join; }