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