1use strict;
2use warnings;
3
4BEGIN {
5    # Import test.pl into its own package
6    {
7        package Test;
8        require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');
9    }
10
11    use Config;
12    if (! $Config{'useithreads'}) {
13        Test::skip_all(q/Perl not compiled with 'useithreads'/);
14    }
15}
16
17use ExtUtils::testlib;
18
19use threads;
20
21BEGIN {
22    if (! eval 'use threads::shared; 1') {
23        Test::skip_all(q/threads::shared not available/);
24    }
25
26    if (($] < 5.008002) && ($threads::shared::VERSION < 0.92)) {
27        Test::skip_all(q/Needs threads::shared 0.92 or later/);
28    }
29
30    require Thread::Queue;
31
32    $| = 1;
33    print("1..78\n");   ### Number of tests that will be run ###
34}
35
36Test::watchdog(60);   # In case we get stuck
37
38my $q = Thread::Queue->new();
39my $TEST = 1;
40
41sub ok
42{
43    $q->enqueue(@_) if @_;
44
45    while ($q->pending()) {
46        my $ok   = $q->dequeue();
47        my $name = $q->dequeue();
48        my $id   = $TEST++;
49
50        if ($ok) {
51            print("ok $id - $name\n");
52        } else {
53            print("not ok $id - $name\n");
54            printf("# Failed test at line %d\n", (caller)[2]);
55        }
56    }
57}
58
59
60
61### Start of Testing ###
62ok(1, 'Loaded');
63
64# Tests freeing the Perl interpreter for each thread
65# See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
66
67my $COUNT;
68share($COUNT);
69my %READY;
70share(%READY);
71
72# Init a thread
73sub th_start
74{
75    my $q = shift;
76    my $tid = threads->tid();
77    $q->enqueue($tid, "Thread $tid started");
78
79    threads->yield();
80
81    my $other;
82    {
83        lock(%READY);
84
85        # Create next thread
86        if ($tid < 18) {
87            my $next = 'th' . $tid;
88            my $th = threads->create($next, $q);
89        } else {
90            # Last thread signals first
91            th_signal($q, 1);
92        }
93
94        # Wait until signalled by another thread
95        while (! exists($READY{$tid})) {
96            cond_wait(%READY);
97        }
98        $other = delete($READY{$tid});
99    }
100    $q->enqueue($tid, "Thread $tid received signal from $other");
101    threads->yield();
102}
103
104# Thread terminating
105sub th_done
106{
107    my $q = shift;
108    my $tid = threads->tid();
109
110    lock($COUNT);
111    $COUNT++;
112    cond_signal($COUNT);
113
114    $q->enqueue($tid, "Thread $tid done");
115}
116
117# Signal another thread to go
118sub th_signal
119{
120    my $q = shift;
121    my $other = shift;
122    $other++;
123    my $tid = threads->tid();
124
125    $q->enqueue($tid, "Thread $tid signalling $other");
126
127    lock(%READY);
128    $READY{$other} = $tid;
129    cond_broadcast(%READY);
130}
131
132#####
133
134sub th1
135{
136    my $q = shift;
137    th_start($q);
138
139    threads->detach();
140
141    th_signal($q, 2);
142    th_signal($q, 6);
143    th_signal($q, 10);
144    th_signal($q, 14);
145
146    th_done($q);
147}
148
149sub th2
150{
151    my $q = shift;
152    th_start($q);
153    threads->detach();
154    th_signal($q, 4);
155    th_done($q);
156}
157
158sub th6
159{
160    my $q = shift;
161    th_start($q);
162    threads->detach();
163    th_signal($q, 8);
164    th_done($q);
165}
166
167sub th10
168{
169    my $q = shift;
170    th_start($q);
171    threads->detach();
172    th_signal($q, 12);
173    th_done($q);
174}
175
176sub th14
177{
178    my $q = shift;
179    th_start($q);
180    threads->detach();
181    th_signal($q, 16);
182    th_done($q);
183}
184
185sub th4
186{
187    my $q = shift;
188    th_start($q);
189    threads->detach();
190    th_signal($q, 3);
191    th_done($q);
192}
193
194sub th8
195{
196    my $q = shift;
197    th_start($q);
198    threads->detach();
199    th_signal($q, 7);
200    th_done($q);
201}
202
203sub th12
204{
205    my $q = shift;
206    th_start($q);
207    threads->detach();
208    th_signal($q, 13);
209    th_done($q);
210}
211
212sub th16
213{
214    my $q = shift;
215    th_start($q);
216    threads->detach();
217    th_signal($q, 17);
218    th_done($q);
219}
220
221sub th3
222{
223    my $q = shift;
224    my $tid = threads->tid();
225    my $other = 5;
226
227    th_start($q);
228    threads->detach();
229    th_signal($q, $other);
230    sleep(1);
231    $q->enqueue(1, "Thread $tid getting return from thread $other");
232    my $ret = threads->object($other+1)->join();
233    $q->enqueue($ret == $other+1, "Thread $tid saw that thread $other returned $ret");
234    th_done($q);
235}
236
237sub th5
238{
239    my $q = shift;
240    th_start($q);
241    th_done($q);
242    return (threads->tid());
243}
244
245
246sub th7
247{
248    my $q = shift;
249    my $tid = threads->tid();
250    my $other = 9;
251
252    th_start($q);
253    threads->detach();
254    th_signal($q, $other);
255    $q->enqueue(1, "Thread $tid getting return from thread $other");
256    my $ret = threads->object($other+1)->join();
257    $q->enqueue($ret == $other+1, "Thread $tid saw that thread $other returned $ret");
258    th_done($q);
259}
260
261sub th9
262{
263    my $q = shift;
264    th_start($q);
265    sleep(1);
266    th_done($q);
267    return (threads->tid());
268}
269
270
271sub th13
272{
273    my $q = shift;
274    my $tid = threads->tid();
275    my $other = 11;
276
277    th_start($q);
278    threads->detach();
279    th_signal($q, $other);
280    sleep(1);
281    $q->enqueue(1, "Thread $tid getting return from thread $other");
282    my $ret = threads->object($other+1)->join();
283    $q->enqueue($ret == $other+1, "Thread $tid saw that thread $other returned $ret");
284    th_done($q);
285}
286
287sub th11
288{
289    my $q = shift;
290    th_start($q);
291    th_done($q);
292    return (threads->tid());
293}
294
295
296sub th17
297{
298    my $q = shift;
299    my $tid = threads->tid();
300    my $other = 15;
301
302    th_start($q);
303    threads->detach();
304    th_signal($q, $other);
305    $q->enqueue(1, "Thread $tid getting return from thread $other");
306    my $ret = threads->object($other+1)->join();
307    $q->enqueue($ret == $other+1, "Thread $tid saw that thread $other returned $ret");
308    th_done($q);
309}
310
311sub th15
312{
313    my $q = shift;
314    th_start($q);
315    sleep(1);
316    th_done($q);
317    return (threads->tid());
318}
319
320
321TEST_STARTS_HERE:
322{
323    $COUNT = 0;
324    threads->create('th1', $q);
325    {
326        lock($COUNT);
327        while ($COUNT < 17) {
328            cond_wait($COUNT);
329            ok();   # Prints out any intermediate results
330        }
331    }
332    sleep(1);
333}
334ok($COUNT == 17, "Done - $COUNT threads");
335
336exit(0);
337
338# EOF
339