8e4f58ebce27b55dd68778ae6ed04e49258d23fd
[perl.git] / ext / threads / t / state.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     use Config;
6     if (! $Config{'useithreads'}) {
7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
8         exit(0);
9     }
10 }
11
12 use ExtUtils::testlib;
13
14 use threads;
15
16 BEGIN {
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
26 my $TEST;
27 BEGIN {
28     share($TEST);
29     $TEST = 1;
30 }
31
32 ok(1, 'Loaded');
33
34 sub 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
54 my ($READY, $GO, $DONE) :shared = (0, 0, 0);
55
56 sub 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
79 sub wait_until_ready
80 {
81     lock($READY);
82     while (! $READY) {
83         cond_wait($READY);
84     }
85 }
86
87 sub 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
106 my $thr = threads->create('do_thread');
107 wait_until_ready();
108 ok($thr->is_running(),    'thread running');
109 ok(threads->list(threads::running) == 1,  'thread running list');
110 ok(! $thr->is_detached(), 'thread not detached');
111 ok(! $thr->is_joinable(), 'thread not joinable');
112 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
113 ok(threads->list(threads::all) == 1, 'thread list');
114
115 thread_go();
116 ok(! $thr->is_running(),  'thread not running');
117 ok(threads->list(threads::running) == 0,  'thread running list');
118 ok(! $thr->is_detached(), 'thread not detached');
119 ok($thr->is_joinable(),   'thread joinable');
120 ok(threads->list(threads::joinable) == 1, 'thread joinable list');
121 ok(threads->list(threads::all) == 1, 'thread list');
122
123 $thr->join();
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 not joinable');
128 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
129 ok(threads->list(threads::all) == 0, 'thread list');
130
131 $thr = threads->create('do_thread');
132 $thr->detach();
133 ok($thr->is_running(),    'thread running');
134 ok(threads->list(threads::running) == 0,  'thread running list');
135 ok($thr->is_detached(),   'thread detached');
136 ok(! $thr->is_joinable(), 'thread not joinable');
137 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
138 ok(threads->list(threads::all) == 0, 'thread list');
139
140 thread_go();
141 ok(! $thr->is_running(),  'thread not 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
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
160 wait_until_ready();
161 ok($thr->is_running(),    'thread running');
162 ok(threads->list(threads::running) == 0,  'thread running list');
163 ok($thr->is_detached(),   'thread detached');
164 ok(! $thr->is_joinable(), 'thread not joinable');
165 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
166 ok(threads->list(threads::all) == 0, 'thread list');
167
168 thread_go();
169 ok(! $thr->is_running(),  'thread not 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
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
258 exit(0);
259
260 # EOF