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