xref: /openbsd-src/gnu/usr.bin/perl/dist/threads/t/state.t (revision b39c515898423c8d899e35282f4b395f7cad3298)
1*b39c5158Smillertuse strict;
2*b39c5158Smillertuse warnings;
3*b39c5158Smillert
4*b39c5158SmillertBEGIN {
5*b39c5158Smillert    use Config;
6*b39c5158Smillert    if (! $Config{'useithreads'}) {
7*b39c5158Smillert        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
8*b39c5158Smillert        exit(0);
9*b39c5158Smillert    }
10*b39c5158Smillert}
11*b39c5158Smillert
12*b39c5158Smillertuse ExtUtils::testlib;
13*b39c5158Smillert
14*b39c5158Smillertuse threads;
15*b39c5158Smillert
16*b39c5158SmillertBEGIN {
17*b39c5158Smillert    if (! eval 'use threads::shared; 1') {
18*b39c5158Smillert        print("1..0 # SKIP threads::shared not available\n");
19*b39c5158Smillert        exit(0);
20*b39c5158Smillert    }
21*b39c5158Smillert
22*b39c5158Smillert    $| = 1;
23*b39c5158Smillert    print("1..59\n");   ### Number of tests that will be run ###
24*b39c5158Smillert};
25*b39c5158Smillert
26*b39c5158Smillertmy $TEST;
27*b39c5158SmillertBEGIN {
28*b39c5158Smillert    share($TEST);
29*b39c5158Smillert    $TEST = 1;
30*b39c5158Smillert}
31*b39c5158Smillert
32*b39c5158Smillertok(1, 'Loaded');
33*b39c5158Smillert
34*b39c5158Smillertsub ok {
35*b39c5158Smillert    my ($ok, $name) = @_;
36*b39c5158Smillert
37*b39c5158Smillert    lock($TEST);
38*b39c5158Smillert    my $id = $TEST++;
39*b39c5158Smillert
40*b39c5158Smillert    # You have to do it this way or VMS will get confused.
41*b39c5158Smillert    if ($ok) {
42*b39c5158Smillert        print("ok $id - $name\n");
43*b39c5158Smillert    } else {
44*b39c5158Smillert        print("not ok $id - $name\n");
45*b39c5158Smillert        printf("# Failed test at line %d\n", (caller)[2]);
46*b39c5158Smillert    }
47*b39c5158Smillert
48*b39c5158Smillert    return ($ok);
49*b39c5158Smillert}
50*b39c5158Smillert
51*b39c5158Smillert
52*b39c5158Smillert### Start of Testing ###
53*b39c5158Smillert
54*b39c5158Smillertmy ($READY, $GO, $DONE) :shared = (0, 0, 0);
55*b39c5158Smillert
56*b39c5158Smillertsub do_thread
57*b39c5158Smillert{
58*b39c5158Smillert    {
59*b39c5158Smillert        lock($DONE);
60*b39c5158Smillert        $DONE = 0;
61*b39c5158Smillert        lock($READY);
62*b39c5158Smillert        $READY = 1;
63*b39c5158Smillert        cond_signal($READY);
64*b39c5158Smillert    }
65*b39c5158Smillert
66*b39c5158Smillert    lock($GO);
67*b39c5158Smillert    while (! $GO) {
68*b39c5158Smillert        cond_wait($GO);
69*b39c5158Smillert    }
70*b39c5158Smillert    $GO = 0;
71*b39c5158Smillert
72*b39c5158Smillert    lock($READY);
73*b39c5158Smillert    $READY = 0;
74*b39c5158Smillert    lock($DONE);
75*b39c5158Smillert    $DONE = 1;
76*b39c5158Smillert    cond_signal($DONE);
77*b39c5158Smillert}
78*b39c5158Smillert
79*b39c5158Smillertsub wait_until_ready
80*b39c5158Smillert{
81*b39c5158Smillert    lock($READY);
82*b39c5158Smillert    while (! $READY) {
83*b39c5158Smillert        cond_wait($READY);
84*b39c5158Smillert    }
85*b39c5158Smillert}
86*b39c5158Smillert
87*b39c5158Smillertsub thread_go
88*b39c5158Smillert{
89*b39c5158Smillert    {
90*b39c5158Smillert        lock($GO);
91*b39c5158Smillert        $GO = 1;
92*b39c5158Smillert        cond_signal($GO);
93*b39c5158Smillert    }
94*b39c5158Smillert
95*b39c5158Smillert    {
96*b39c5158Smillert        lock($DONE);
97*b39c5158Smillert        while (! $DONE) {
98*b39c5158Smillert            cond_wait($DONE);
99*b39c5158Smillert        }
100*b39c5158Smillert    }
101*b39c5158Smillert    threads->yield();
102*b39c5158Smillert    sleep(1);
103*b39c5158Smillert}
104*b39c5158Smillert
105*b39c5158Smillert
106*b39c5158Smillertmy $thr = threads->create('do_thread');
107*b39c5158Smillertwait_until_ready();
108*b39c5158Smillertok($thr->is_running(),    'thread running');
109*b39c5158Smillertok(threads->list(threads::running) == 1,  'thread running list');
110*b39c5158Smillertok(! $thr->is_detached(), 'thread not detached');
111*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable');
112*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list');
113*b39c5158Smillertok(threads->list(threads::all) == 1, 'thread list');
114*b39c5158Smillert
115*b39c5158Smillertthread_go();
116*b39c5158Smillertok(! $thr->is_running(),  'thread not running');
117*b39c5158Smillertok(threads->list(threads::running) == 0,  'thread running list');
118*b39c5158Smillertok(! $thr->is_detached(), 'thread not detached');
119*b39c5158Smillertok($thr->is_joinable(),   'thread joinable');
120*b39c5158Smillertok(threads->list(threads::joinable) == 1, 'thread joinable list');
121*b39c5158Smillertok(threads->list(threads::all) == 1, 'thread list');
122*b39c5158Smillert
123*b39c5158Smillert$thr->join();
124*b39c5158Smillertok(! $thr->is_running(),  'thread not running');
125*b39c5158Smillertok(threads->list(threads::running) == 0,  'thread running list');
126*b39c5158Smillertok(! $thr->is_detached(), 'thread not detached');
127*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable');
128*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list');
129*b39c5158Smillertok(threads->list(threads::all) == 0, 'thread list');
130*b39c5158Smillert
131*b39c5158Smillert$thr = threads->create('do_thread');
132*b39c5158Smillert$thr->detach();
133*b39c5158Smillertok($thr->is_running(),    'thread running');
134*b39c5158Smillertok(threads->list(threads::running) == 0,  'thread running list');
135*b39c5158Smillertok($thr->is_detached(),   'thread detached');
136*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable');
137*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list');
138*b39c5158Smillertok(threads->list(threads::all) == 0, 'thread list');
139*b39c5158Smillert
140*b39c5158Smillertthread_go();
141*b39c5158Smillertok(! $thr->is_running(),  'thread not running');
142*b39c5158Smillertok(threads->list(threads::running) == 0,  'thread running list');
143*b39c5158Smillertok($thr->is_detached(),   'thread detached');
144*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable');
145*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list');
146*b39c5158Smillert
147*b39c5158Smillert$thr = threads->create(sub {
148*b39c5158Smillert    ok(! threads->is_detached(), 'thread not detached');
149*b39c5158Smillert    ok(threads->list(threads::running) == 1, 'thread running list');
150*b39c5158Smillert    ok(threads->list(threads::joinable) == 0, 'thread joinable list');
151*b39c5158Smillert    ok(threads->list(threads::all) == 1, 'thread list');
152*b39c5158Smillert    threads->detach();
153*b39c5158Smillert    do_thread();
154*b39c5158Smillert    ok(threads->is_detached(),   'thread detached');
155*b39c5158Smillert    ok(threads->list(threads::running) == 0, 'thread running list');
156*b39c5158Smillert    ok(threads->list(threads::joinable) == 0, 'thread joinable list');
157*b39c5158Smillert    ok(threads->list(threads::all) == 0, 'thread list');
158*b39c5158Smillert});
159*b39c5158Smillert
160*b39c5158Smillertwait_until_ready();
161*b39c5158Smillertok($thr->is_running(),    'thread running');
162*b39c5158Smillertok(threads->list(threads::running) == 0,  'thread running list');
163*b39c5158Smillertok($thr->is_detached(),   'thread detached');
164*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable');
165*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list');
166*b39c5158Smillertok(threads->list(threads::all) == 0, 'thread list');
167*b39c5158Smillert
168*b39c5158Smillertthread_go();
169*b39c5158Smillertok(! $thr->is_running(),  'thread not running');
170*b39c5158Smillertok(threads->list(threads::running) == 0,  'thread running list');
171*b39c5158Smillertok($thr->is_detached(),   'thread detached');
172*b39c5158Smillertok(! $thr->is_joinable(), 'thread not joinable');
173*b39c5158Smillertok(threads->list(threads::joinable) == 0, 'thread joinable list');
174*b39c5158Smillert
175*b39c5158Smillert{
176*b39c5158Smillert    my $go : shared = 0;
177*b39c5158Smillert    my $t = threads->create( sub {
178*b39c5158Smillert        ok(! threads->is_detached(), 'thread not detached');
179*b39c5158Smillert        ok(threads->list(threads::running) == 1, 'thread running list');
180*b39c5158Smillert        ok(threads->list(threads::joinable) == 0, 'thread joinable list');
181*b39c5158Smillert        ok(threads->list(threads::all) == 1, 'thread list');
182*b39c5158Smillert        lock($go); $go = 1; cond_signal($go);
183*b39c5158Smillert    });
184*b39c5158Smillert
185*b39c5158Smillert    { lock ($go); cond_wait($go) until $go; }
186*b39c5158Smillert    $t->join;
187*b39c5158Smillert}
188*b39c5158Smillert
189*b39c5158Smillert{
190*b39c5158Smillert    my $rdy :shared = 0;
191*b39c5158Smillert    sub thr_ready
192*b39c5158Smillert    {
193*b39c5158Smillert        lock($rdy);
194*b39c5158Smillert        $rdy++;
195*b39c5158Smillert        cond_signal($rdy);
196*b39c5158Smillert    }
197*b39c5158Smillert
198*b39c5158Smillert    my $go :shared = 0;
199*b39c5158Smillert    sub thr_wait
200*b39c5158Smillert    {
201*b39c5158Smillert        lock($go);
202*b39c5158Smillert        cond_wait($go) until $go;
203*b39c5158Smillert    }
204*b39c5158Smillert
205*b39c5158Smillert    my $done :shared = 0;
206*b39c5158Smillert    sub thr_done
207*b39c5158Smillert    {
208*b39c5158Smillert        lock($done);
209*b39c5158Smillert        $done++;
210*b39c5158Smillert        cond_signal($done);
211*b39c5158Smillert    }
212*b39c5158Smillert
213*b39c5158Smillert    my $thr_routine = sub { thr_ready(); thr_wait(); thr_done(); };
214*b39c5158Smillert
215*b39c5158Smillert    # Create 8 threads:
216*b39c5158Smillert    #  3 running, blocking on $go
217*b39c5158Smillert    #  2 running, blocking on $go, join pending
218*b39c5158Smillert    #  2 running, blocking on join of above
219*b39c5158Smillert    #  1 finished, unjoined
220*b39c5158Smillert
221*b39c5158Smillert    for (1..3) { threads->create($thr_routine); }
222*b39c5158Smillert
223*b39c5158Smillert    foreach my $t (map {threads->create($thr_routine)} 1..2) {
224*b39c5158Smillert        threads->create(sub { thr_ready(); $_[0]->join; thr_done(); }, $t);
225*b39c5158Smillert    }
226*b39c5158Smillert    threads->create(sub { thr_ready(); thr_done(); });
227*b39c5158Smillert    {
228*b39c5158Smillert        lock($done);
229*b39c5158Smillert        cond_wait($done) until ($done == 1);
230*b39c5158Smillert    }
231*b39c5158Smillert    {
232*b39c5158Smillert        lock($rdy);
233*b39c5158Smillert        cond_wait($rdy) until ($rdy == 8);
234*b39c5158Smillert    }
235*b39c5158Smillert    threads->yield();
236*b39c5158Smillert    sleep(1);
237*b39c5158Smillert
238*b39c5158Smillert    ok(threads->list(threads::running) == 5, 'thread running list');
239*b39c5158Smillert    ok(threads->list(threads::joinable) == 1, 'thread joinable list');
240*b39c5158Smillert    ok(threads->list(threads::all) == 6, 'thread all list');
241*b39c5158Smillert
242*b39c5158Smillert    { lock($go); $go = 1; cond_broadcast($go); }
243*b39c5158Smillert    {
244*b39c5158Smillert        lock($done);
245*b39c5158Smillert        cond_wait($done) until ($done == 8);
246*b39c5158Smillert    }
247*b39c5158Smillert    threads->yield();
248*b39c5158Smillert    sleep(1);
249*b39c5158Smillert
250*b39c5158Smillert    ok(threads->list(threads::running) == 0, 'thread running list');
251*b39c5158Smillert    # Two awaiting join() have completed
252*b39c5158Smillert    ok(threads->list(threads::joinable) == 6, 'thread joinable list');
253*b39c5158Smillert    ok(threads->list(threads::all) == 6, 'thread all list');
254*b39c5158Smillert
255*b39c5158Smillert    for (threads->list) { $_->join; }
256*b39c5158Smillert}
257*b39c5158Smillert
258*b39c5158Smillertexit(0);
259*b39c5158Smillert
260*b39c5158Smillert# EOF
261