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; |
23 | import threads::shared; |
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 | |
35 | $| = 1; |
d4315dd6 |
36 | print("1..78\n"); ### Number of tests that will be run ### |
385d56e4 |
37 | }; |
38 | |
4dcb9e53 |
39 | my $TEST; |
40 | BEGIN { |
41 | share($TEST); |
42 | $TEST = 1; |
43 | } |
385d56e4 |
44 | |
45 | ok(1, 'Loaded'); |
46 | |
47 | sub ok { |
48 | my ($ok, $name) = @_; |
49 | |
50 | lock($TEST); |
51 | my $id = $TEST++; |
52 | |
53 | # You have to do it this way or VMS will get confused. |
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 | |
61 | return ($ok); |
62 | } |
63 | |
64 | |
65 | ### Start of Testing ### |
66 | |
67 | # Tests freeing the Perl interperter for each thread |
68 | # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details |
69 | |
70 | my $COUNT; |
71 | share($COUNT); |
72 | my %READY; |
73 | share(%READY); |
74 | |
75 | # Init a thread |
76 | sub th_start { |
77 | my $tid = threads->tid(); |
78 | ok($tid, "Thread $tid started"); |
79 | |
d4315dd6 |
80 | threads->yield(); |
81 | |
82 | my $other; |
83 | { |
84 | lock(%READY); |
85 | |
86 | # Create next thread |
87 | if ($tid < 17) { |
88 | my $next = 'th' . ($tid+1); |
89 | my $th = threads->create($next); |
90 | } else { |
91 | # Last thread signals first |
92 | th_signal(1); |
93 | } |
94 | |
95 | # Wait until signalled by another thread |
96 | while (! exists($READY{$tid})) { |
97 | cond_wait(%READY); |
98 | } |
99 | $other = delete($READY{$tid}); |
385d56e4 |
100 | } |
d4315dd6 |
101 | ok($tid, "Thread $tid received signal from $other"); |
102 | threads->yield(); |
385d56e4 |
103 | } |
104 | |
105 | # Thread terminating |
106 | sub th_done { |
107 | my $tid = threads->tid(); |
108 | |
109 | lock($COUNT); |
110 | $COUNT++; |
111 | cond_signal($COUNT); |
112 | |
113 | ok($tid, "Thread $tid done"); |
114 | } |
115 | |
385d56e4 |
116 | # Signal another thread to go |
117 | sub th_signal |
118 | { |
119 | my $other = shift; |
120 | my $tid = threads->tid(); |
121 | |
122 | ok($tid, "Thread $tid signalling $other"); |
123 | |
124 | lock(%READY); |
125 | $READY{$other} = $tid; |
126 | cond_broadcast(%READY); |
127 | } |
128 | |
129 | ##### |
130 | |
131 | sub th1 { |
132 | th_start(); |
133 | |
134 | threads->detach(); |
135 | |
136 | th_signal(2); |
137 | th_signal(6); |
138 | th_signal(10); |
139 | th_signal(14); |
140 | |
141 | th_done(); |
142 | } |
143 | |
144 | sub th2 { |
145 | th_start(); |
146 | threads->detach(); |
147 | th_signal(4); |
148 | th_done(); |
149 | } |
150 | |
151 | sub th6 { |
152 | th_start(); |
153 | threads->detach(); |
154 | th_signal(8); |
155 | th_done(); |
156 | } |
157 | |
158 | sub th10 { |
159 | th_start(); |
160 | threads->detach(); |
161 | th_signal(12); |
162 | th_done(); |
163 | } |
164 | |
165 | sub th14 { |
166 | th_start(); |
167 | threads->detach(); |
168 | th_signal(16); |
169 | th_done(); |
170 | } |
171 | |
172 | sub th4 { |
173 | th_start(); |
174 | threads->detach(); |
175 | th_signal(3); |
176 | th_done(); |
177 | } |
178 | |
179 | sub th8 { |
180 | th_start(); |
181 | threads->detach(); |
182 | th_signal(7); |
183 | th_done(); |
184 | } |
185 | |
186 | sub th12 { |
187 | th_start(); |
188 | threads->detach(); |
189 | th_signal(13); |
190 | th_done(); |
191 | } |
192 | |
193 | sub th16 { |
194 | th_start(); |
195 | threads->detach(); |
196 | th_signal(17); |
197 | th_done(); |
198 | } |
199 | |
200 | sub th3 { |
d4315dd6 |
201 | my $tid = threads->tid(); |
385d56e4 |
202 | my $other = 5; |
203 | |
204 | th_start(); |
205 | threads->detach(); |
206 | th_signal($other); |
385d56e4 |
207 | sleep(1); |
d4315dd6 |
208 | ok(1, "Thread $tid getting return from thread $other"); |
385d56e4 |
209 | my $ret = threads->object($other)->join(); |
d4315dd6 |
210 | ok($ret == $other, "Thread $tid saw that thread $other returned $ret"); |
385d56e4 |
211 | th_done(); |
212 | } |
213 | |
214 | sub th5 { |
215 | th_start(); |
216 | th_done(); |
217 | return (threads->tid()); |
218 | } |
219 | |
220 | |
221 | sub th7 { |
d4315dd6 |
222 | my $tid = threads->tid(); |
385d56e4 |
223 | my $other = 9; |
224 | |
225 | th_start(); |
226 | threads->detach(); |
227 | th_signal($other); |
d4315dd6 |
228 | ok(1, "Thread $tid getting return from thread $other"); |
385d56e4 |
229 | my $ret = threads->object($other)->join(); |
d4315dd6 |
230 | ok($ret == $other, "Thread $tid saw that thread $other returned $ret"); |
385d56e4 |
231 | th_done(); |
232 | } |
233 | |
234 | sub th9 { |
235 | th_start(); |
385d56e4 |
236 | sleep(1); |
237 | th_done(); |
238 | return (threads->tid()); |
239 | } |
240 | |
241 | |
242 | sub th13 { |
d4315dd6 |
243 | my $tid = threads->tid(); |
385d56e4 |
244 | my $other = 11; |
245 | |
246 | th_start(); |
247 | threads->detach(); |
248 | th_signal($other); |
385d56e4 |
249 | sleep(1); |
d4315dd6 |
250 | ok(1, "Thread $tid getting return from thread $other"); |
385d56e4 |
251 | my $ret = threads->object($other)->join(); |
d4315dd6 |
252 | ok($ret == $other, "Thread $tid saw that thread $other returned $ret"); |
385d56e4 |
253 | th_done(); |
254 | } |
255 | |
256 | sub th11 { |
257 | th_start(); |
258 | th_done(); |
259 | return (threads->tid()); |
260 | } |
261 | |
262 | |
263 | sub th17 { |
d4315dd6 |
264 | my $tid = threads->tid(); |
385d56e4 |
265 | my $other = 15; |
266 | |
267 | th_start(); |
268 | threads->detach(); |
269 | th_signal($other); |
d4315dd6 |
270 | ok(1, "Thread $tid getting return from thread $other"); |
385d56e4 |
271 | my $ret = threads->object($other)->join(); |
d4315dd6 |
272 | ok($ret == $other, "Thread $tid saw that thread $other returned $ret"); |
385d56e4 |
273 | th_done(); |
274 | } |
275 | |
276 | sub th15 { |
277 | th_start(); |
385d56e4 |
278 | sleep(1); |
279 | th_done(); |
280 | return (threads->tid()); |
281 | } |
282 | |
283 | |
385d56e4 |
284 | TEST_STARTS_HERE: |
285 | { |
286 | $COUNT = 0; |
287 | threads->create('th1'); |
288 | { |
289 | lock($COUNT); |
290 | while ($COUNT < 17) { |
291 | cond_wait($COUNT); |
292 | } |
293 | } |
385d56e4 |
294 | sleep(1); |
295 | } |
296 | ok($COUNT == 17, "Done - $COUNT threads"); |
297 | |
298 | # EOF |