This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
threads 1.64 (repost)
[perl5.git] / ext / threads / t / state.t
CommitLineData
ead32952
JH
1use strict;
2use warnings;
3
4BEGIN {
5 if ($ENV{'PERL_CORE'}){
6 chdir 't';
7 unshift @INC, '../lib';
8 }
9 use Config;
10 if (! $Config{'useithreads'}) {
11 print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
12 exit(0);
13 }
14}
15
16use ExtUtils::testlib;
17
18use threads;
19
20BEGIN {
21 eval {
22 require threads::shared;
f3086ff0 23 threads::shared->import();
ead32952
JH
24 };
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # Skip: threads::shared not available\n");
27 exit(0);
28 }
29
30 $| = 1;
8718f9a1 31 print("1..59\n"); ### Number of tests that will be run ###
ead32952
JH
32};
33
34my $TEST;
35BEGIN {
36 share($TEST);
37 $TEST = 1;
38}
39
40ok(1, 'Loaded');
41
42sub ok {
43 my ($ok, $name) = @_;
44
45 lock($TEST);
46 my $id = $TEST++;
47
48 # You have to do it this way or VMS will get confused.
49 if ($ok) {
50 print("ok $id - $name\n");
51 } else {
52 print("not ok $id - $name\n");
53 printf("# Failed test at line %d\n", (caller)[2]);
54 }
55
56 return ($ok);
57}
58
59
60### Start of Testing ###
61
62my ($READY, $GO, $DONE) :shared = (0, 0, 0);
63
64sub do_thread
65{
66 {
67 lock($DONE);
68 $DONE = 0;
69 lock($READY);
70 $READY = 1;
71 cond_signal($READY);
72 }
73
74 lock($GO);
75 while (! $GO) {
76 cond_wait($GO);
77 }
78 $GO = 0;
79
80 lock($READY);
81 $READY = 0;
82 lock($DONE);
83 $DONE = 1;
84 cond_signal($DONE);
85}
86
87sub wait_until_ready
88{
89 lock($READY);
90 while (! $READY) {
91 cond_wait($READY);
92 }
93}
94
95sub thread_go
96{
97 {
98 lock($GO);
99 $GO = 1;
100 cond_signal($GO);
101 }
102
103 {
104 lock($DONE);
105 while (! $DONE) {
106 cond_wait($DONE);
107 }
108 }
109 threads->yield();
110 sleep(1);
111}
112
113
114my $thr = threads->create('do_thread');
115wait_until_ready();
116ok($thr->is_running(), 'thread running');
117ok(threads->list(threads::running) == 1, 'thread running list');
118ok(! $thr->is_detached(), 'thread not detached');
119ok(! $thr->is_joinable(), 'thread not joinable');
120ok(threads->list(threads::joinable) == 0, 'thread joinable list');
121ok(threads->list(threads::all) == 1, 'thread list');
122
123thread_go();
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 joinable');
128ok(threads->list(threads::joinable) == 1, 'thread joinable list');
129ok(threads->list(threads::all) == 1, 'thread list');
130
131$thr->join();
132ok(! $thr->is_running(), 'thread not running');
133ok(threads->list(threads::running) == 0, 'thread running list');
134ok(! $thr->is_detached(), 'thread not detached');
135ok(! $thr->is_joinable(), 'thread not joinable');
136ok(threads->list(threads::joinable) == 0, 'thread joinable list');
137ok(threads->list(threads::all) == 0, 'thread list');
138
139$thr = threads->create('do_thread');
140$thr->detach();
141ok($thr->is_running(), 'thread 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');
146ok(threads->list(threads::all) == 0, 'thread list');
147
148thread_go();
149ok(! $thr->is_running(), 'thread not running');
150ok(threads->list(threads::running) == 0, 'thread running list');
151ok($thr->is_detached(), 'thread detached');
152ok(! $thr->is_joinable(), 'thread not joinable');
153ok(threads->list(threads::joinable) == 0, 'thread joinable list');
154
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');
160 threads->detach();
161 do_thread();
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');
166});
167
168wait_until_ready();
169ok($thr->is_running(), 'thread 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');
174ok(threads->list(threads::all) == 0, 'thread list');
175
176thread_go();
177ok(! $thr->is_running(), 'thread not running');
178ok(threads->list(threads::running) == 0, 'thread running list');
179ok($thr->is_detached(), 'thread detached');
180ok(! $thr->is_joinable(), 'thread not joinable');
181ok(threads->list(threads::joinable) == 0, 'thread joinable list');
182
8718f9a1
JH
183{
184 my $go : shared = 0;
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);
191 });
192
193 { lock ($go); cond_wait($go) until $go; }
194 $t->join;
195}
196
197{
198 my $rdy :shared = 0;
199 sub thr_ready
200 {
201 lock($rdy);
202 $rdy++;
203 cond_signal($rdy);
204 }
205
206 my $go :shared = 0;
207 sub thr_wait
208 {
209 lock($go);
210 cond_wait($go) until $go;
211 }
212
213 my $done :shared = 0;
214 sub thr_done
215 {
216 lock($done);
217 $done++;
218 cond_signal($done);
219 }
220
221 my $thr_routine = sub { thr_ready(); thr_wait(); thr_done(); };
222
223 # Create 8 threads:
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
228
229 for (1..3) { threads->create($thr_routine); }
230
231 foreach my $t (map {threads->create($thr_routine)} 1..2) {
232 threads->create(sub { thr_ready(); $_[0]->join; thr_done(); }, $t);
233 }
234 threads->create(sub { thr_ready(); thr_done(); });
235 {
236 lock($done);
237 cond_wait($done) until ($done == 1);
238 }
239 {
240 lock($rdy);
241 cond_wait($rdy) until ($rdy == 8);
242 }
243 threads->yield();
244 sleep(1);
245
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');
249
250 { lock($go); $go = 1; cond_broadcast($go); }
251 {
252 lock($done);
253 cond_wait($done) until ($done == 8);
254 }
255 threads->yield();
256 sleep(1);
257
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');
262
263 for (threads->list) { $_->join; }
264}
ead32952
JH
265
266# EOF