99761302c698d9e9a9639be04e2ca73f65a32a0d
[perl.git] / ext / threads / t / free2.t
1 use strict;
2 use warnings;
3
4 BEGIN {
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
17 use ExtUtils::testlib;
18
19 use threads;
20
21 BEGIN {
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
36 Test::watchdog(60);   # In case we get stuck
37
38 my $q = Thread::Queue->new();
39 my $TEST = 1;
40
41 sub 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 ###
62 ok(1, 'Loaded');
63
64 # Tests freeing the Perl interperter for each thread
65 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
66
67 my $COUNT;
68 share($COUNT);
69 my %READY;
70 share(%READY);
71
72 # Init a thread
73 sub 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
105 sub 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
118 sub 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
134 sub 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
149 sub th2
150 {
151     my $q = shift;
152     th_start($q);
153     threads->detach();
154     th_signal($q, 4);
155     th_done($q);
156 }
157
158 sub th6
159 {
160     my $q = shift;
161     th_start($q);
162     threads->detach();
163     th_signal($q, 8);
164     th_done($q);
165 }
166
167 sub th10
168 {
169     my $q = shift;
170     th_start($q);
171     threads->detach();
172     th_signal($q, 12);
173     th_done($q);
174 }
175
176 sub th14
177 {
178     my $q = shift;
179     th_start($q);
180     threads->detach();
181     th_signal($q, 16);
182     th_done($q);
183 }
184
185 sub th4
186 {
187     my $q = shift;
188     th_start($q);
189     threads->detach();
190     th_signal($q, 3);
191     th_done($q);
192 }
193
194 sub th8
195 {
196     my $q = shift;
197     th_start($q);
198     threads->detach();
199     th_signal($q, 7);
200     th_done($q);
201 }
202
203 sub th12
204 {
205     my $q = shift;
206     th_start($q);
207     threads->detach();
208     th_signal($q, 13);
209     th_done($q);
210 }
211
212 sub th16
213 {
214     my $q = shift;
215     th_start($q);
216     threads->detach();
217     th_signal($q, 17);
218     th_done($q);
219 }
220
221 sub 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
237 sub th5
238 {
239     my $q = shift;
240     th_start($q);
241     th_done($q);
242     return (threads->tid());
243 }
244
245
246 sub 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
261 sub th9
262 {
263     my $q = shift;
264     th_start($q);
265     sleep(1);
266     th_done($q);
267     return (threads->tid());
268 }
269
270
271 sub 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
287 sub th11
288 {
289     my $q = shift;
290     th_start($q);
291     th_done($q);
292     return (threads->tid());
293 }
294
295
296 sub 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
311 sub th15
312 {
313     my $q = shift;
314     th_start($q);
315     sleep(1);
316     th_done($q);
317     return (threads->tid());
318 }
319
320
321 TEST_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 }
334 ok($COUNT == 17, "Done - $COUNT threads");
335
336 exit(0);
337
338 # EOF