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
1 use strict;
2 use warnings;
3
4 BEGIN {
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
16 use ExtUtils::testlib;
17
18 use threads;
19
20 BEGIN {
21     eval {
22         require threads::shared;
23         threads::shared->import();
24     };
25     if ($@ || ! $threads::shared::threads_shared) {
26         print("1..0 # Skip: threads::shared not available\n");
27         exit(0);
28     }
29
30     $| = 1;
31     print("1..59\n");   ### Number of tests that will be run ###
32 };
33
34 my $TEST;
35 BEGIN {
36     share($TEST);
37     $TEST = 1;
38 }
39
40 ok(1, 'Loaded');
41
42 sub 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
62 my ($READY, $GO, $DONE) :shared = (0, 0, 0);
63
64 sub 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
87 sub wait_until_ready
88 {
89     lock($READY);
90     while (! $READY) {
91         cond_wait($READY);
92     }
93 }
94
95 sub 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
114 my $thr = threads->create('do_thread');
115 wait_until_ready();
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');
122
123 thread_go();
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');
130
131 $thr->join();
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');
138
139 $thr = threads->create('do_thread');
140 $thr->detach();
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');
147
148 thread_go();
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');
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
168 wait_until_ready();
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');
175
176 thread_go();
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');
182
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 }
265
266 # EOF