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; |
36 | print("1..74\n"); ### Number of tests that will be run ### |
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 | |
80 | # Create next thread |
81 | if ($tid < 17) { |
82 | my $next = 'th' . ($tid+1); |
83 | my $th = threads->create($next); |
84 | } else { |
85 | # Last thread signals first |
86 | th_signal(1); |
87 | } |
88 | th_wait(); |
89 | } |
90 | |
91 | # Thread terminating |
92 | sub th_done { |
93 | my $tid = threads->tid(); |
94 | |
95 | lock($COUNT); |
96 | $COUNT++; |
97 | cond_signal($COUNT); |
98 | |
99 | ok($tid, "Thread $tid done"); |
100 | } |
101 | |
102 | # Wait until signalled by another thread |
103 | sub th_wait |
104 | { |
105 | my $tid = threads->tid(); |
106 | |
107 | lock(%READY); |
108 | while (! exists($READY{$tid})) { |
109 | cond_wait(%READY); |
110 | } |
111 | my $other = delete($READY{$tid}); |
112 | ok($tid, "Thread $tid received signal from $other"); |
113 | } |
114 | |
115 | # Signal another thread to go |
116 | sub th_signal |
117 | { |
118 | my $other = shift; |
119 | my $tid = threads->tid(); |
120 | |
121 | ok($tid, "Thread $tid signalling $other"); |
122 | |
123 | lock(%READY); |
124 | $READY{$other} = $tid; |
125 | cond_broadcast(%READY); |
126 | } |
127 | |
128 | ##### |
129 | |
130 | sub th1 { |
131 | th_start(); |
132 | |
133 | threads->detach(); |
134 | |
135 | th_signal(2); |
136 | th_signal(6); |
137 | th_signal(10); |
138 | th_signal(14); |
139 | |
140 | th_done(); |
141 | } |
142 | |
143 | sub th2 { |
144 | th_start(); |
145 | threads->detach(); |
146 | th_signal(4); |
147 | th_done(); |
148 | } |
149 | |
150 | sub th6 { |
151 | th_start(); |
152 | threads->detach(); |
153 | th_signal(8); |
154 | th_done(); |
155 | } |
156 | |
157 | sub th10 { |
158 | th_start(); |
159 | threads->detach(); |
160 | th_signal(12); |
161 | th_done(); |
162 | } |
163 | |
164 | sub th14 { |
165 | th_start(); |
166 | threads->detach(); |
167 | th_signal(16); |
168 | th_done(); |
169 | } |
170 | |
171 | sub th4 { |
172 | th_start(); |
173 | threads->detach(); |
174 | th_signal(3); |
175 | th_done(); |
176 | } |
177 | |
178 | sub th8 { |
179 | th_start(); |
180 | threads->detach(); |
181 | th_signal(7); |
182 | th_done(); |
183 | } |
184 | |
185 | sub th12 { |
186 | th_start(); |
187 | threads->detach(); |
188 | th_signal(13); |
189 | th_done(); |
190 | } |
191 | |
192 | sub th16 { |
193 | th_start(); |
194 | threads->detach(); |
195 | th_signal(17); |
196 | th_done(); |
197 | } |
198 | |
199 | sub th3 { |
200 | my $other = 5; |
201 | |
202 | th_start(); |
203 | threads->detach(); |
204 | th_signal($other); |
205 | threads->yield(); |
206 | sleep(1); |
207 | my $ret = threads->object($other)->join(); |
208 | ok($ret == $other, "Thread $other returned $ret"); |
209 | th_done(); |
210 | } |
211 | |
212 | sub th5 { |
213 | th_start(); |
214 | th_done(); |
215 | return (threads->tid()); |
216 | } |
217 | |
218 | |
219 | sub th7 { |
220 | my $other = 9; |
221 | |
222 | th_start(); |
223 | threads->detach(); |
224 | th_signal($other); |
225 | my $ret = threads->object($other)->join(); |
226 | ok($ret == $other, "Thread $other returned $ret"); |
227 | th_done(); |
228 | } |
229 | |
230 | sub th9 { |
231 | th_start(); |
232 | threads->yield(); |
233 | sleep(1); |
234 | th_done(); |
235 | return (threads->tid()); |
236 | } |
237 | |
238 | |
239 | sub th13 { |
240 | my $other = 11; |
241 | |
242 | th_start(); |
243 | threads->detach(); |
244 | th_signal($other); |
245 | threads->yield(); |
246 | sleep(1); |
247 | my $ret = threads->object($other)->join(); |
248 | ok($ret == $other, "Thread $other returned $ret"); |
249 | th_done(); |
250 | } |
251 | |
252 | sub th11 { |
253 | th_start(); |
254 | th_done(); |
255 | return (threads->tid()); |
256 | } |
257 | |
258 | |
259 | sub th17 { |
260 | my $other = 15; |
261 | |
262 | th_start(); |
263 | threads->detach(); |
264 | th_signal($other); |
265 | my $ret = threads->object($other)->join(); |
266 | ok($ret == $other, "Thread $other returned $ret"); |
267 | th_done(); |
268 | } |
269 | |
270 | sub th15 { |
271 | th_start(); |
272 | threads->yield(); |
273 | sleep(1); |
274 | th_done(); |
275 | return (threads->tid()); |
276 | } |
277 | |
278 | |
279 | |
280 | |
281 | |
282 | |
283 | TEST_STARTS_HERE: |
284 | { |
285 | $COUNT = 0; |
286 | threads->create('th1'); |
287 | { |
288 | lock($COUNT); |
289 | while ($COUNT < 17) { |
290 | cond_wait($COUNT); |
291 | } |
292 | } |
293 | threads->yield(); |
294 | sleep(1); |
295 | } |
296 | ok($COUNT == 17, "Done - $COUNT threads"); |
297 | |
298 | # EOF |