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