This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
threads 1.64 (repost)
[perl5.git] / ext / threads / t / free2.t
CommitLineData
385d56e4
JH
1use strict;
2use warnings;
3
4BEGIN {
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
16use ExtUtils::testlib;
17
18use threads;
385d56e4
JH
19
20BEGIN {
58a3a76c
JH
21 eval {
22 require threads::shared;
f3086ff0 23 threads::shared->import();
58a3a76c
JH
24 };
25 if ($@ || ! $threads::shared::threads_shared) {
26 print("1..0 # Skip: threads::shared not available\n");
27 exit(0);
28 }
29
385d56e4
JH
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
JH
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
JH
42my $q = Thread::Queue->new();
43my $TEST = 1;
385d56e4 44
18b9e6f5
JH
45sub ok
46{
47 $q->enqueue(@_) if @_;
385d56e4 48
18b9e6f5
JH
49 while ($q->pending()) {
50 my $ok = $q->dequeue();
51 my $name = $q->dequeue();
52 my $id = $TEST++;
385d56e4 53
18b9e6f5
JH
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
JH
61}
62
63
18b9e6f5 64
385d56e4 65### Start of Testing ###
18b9e6f5 66ok(1, 'Loaded');
385d56e4
JH
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
71my $COUNT;
72share($COUNT);
73my %READY;
74share(%READY);
75
76# Init a thread
18b9e6f5
JH
77sub th_start
78{
79 my $q = shift;
385d56e4 80 my $tid = threads->tid();
18b9e6f5 81 $q->enqueue($tid, "Thread $tid started");
385d56e4 82
d4315dd6
JH
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
JH
93 } else {
94 # Last thread signals first
18b9e6f5 95 th_signal($q, 1);
d4315dd6
JH
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
JH
106}
107
108# Thread terminating
18b9e6f5
JH
109sub th_done
110{
111 my $q = shift;
385d56e4
JH
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
JH
119}
120
385d56e4
JH
121# Signal another thread to go
122sub th_signal
123{
18b9e6f5 124 my $q = shift;
385d56e4
JH
125 my $other = shift;
126 my $tid = threads->tid();
127
18b9e6f5 128 $q->enqueue($tid, "Thread $tid signalling $other");
385d56e4
JH
129
130 lock(%READY);
131 $READY{$other} = $tid;
132 cond_broadcast(%READY);
133}
134
135#####
136
18b9e6f5
JH
137sub th1
138{
139 my $q = shift;
140 th_start($q);
385d56e4
JH
141
142 threads->detach();
143
18b9e6f5
JH
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
JH
150}
151
18b9e6f5
JH
152sub th2
153{
154 my $q = shift;
155 th_start($q);
385d56e4 156 threads->detach();
18b9e6f5
JH
157 th_signal($q, 4);
158 th_done($q);
385d56e4
JH
159}
160
18b9e6f5
JH
161sub th6
162{
163 my $q = shift;
164 th_start($q);
385d56e4 165 threads->detach();
18b9e6f5
JH
166 th_signal($q, 8);
167 th_done($q);
385d56e4
JH
168}
169
18b9e6f5
JH
170sub th10
171{
172 my $q = shift;
173 th_start($q);
385d56e4 174 threads->detach();
18b9e6f5
JH
175 th_signal($q, 12);
176 th_done($q);
385d56e4
JH
177}
178
18b9e6f5
JH
179sub th14
180{
181 my $q = shift;
182 th_start($q);
385d56e4 183 threads->detach();
18b9e6f5
JH
184 th_signal($q, 16);
185 th_done($q);
385d56e4
JH
186}
187
18b9e6f5
JH
188sub th4
189{
190 my $q = shift;
191 th_start($q);
385d56e4 192 threads->detach();
18b9e6f5
JH
193 th_signal($q, 3);
194 th_done($q);
385d56e4
JH
195}
196
18b9e6f5
JH
197sub th8
198{
199 my $q = shift;
200 th_start($q);
385d56e4 201 threads->detach();
18b9e6f5
JH
202 th_signal($q, 7);
203 th_done($q);
385d56e4
JH
204}
205
18b9e6f5
JH
206sub th12
207{
208 my $q = shift;
209 th_start($q);
385d56e4 210 threads->detach();
18b9e6f5
JH
211 th_signal($q, 13);
212 th_done($q);
385d56e4
JH
213}
214
18b9e6f5
JH
215sub th16
216{
217 my $q = shift;
218 th_start($q);
385d56e4 219 threads->detach();
18b9e6f5
JH
220 th_signal($q, 17);
221 th_done($q);
385d56e4
JH
222}
223
18b9e6f5
JH
224sub th3
225{
226 my $q = shift;
d4315dd6 227 my $tid = threads->tid();
385d56e4
JH
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
JH
236 $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
237 th_done($q);
385d56e4
JH
238}
239
18b9e6f5
JH
240sub th5
241{
242 my $q = shift;
243 th_start($q);
244 th_done($q);
385d56e4
JH
245 return (threads->tid());
246}
247
248
18b9e6f5
JH
249sub th7
250{
251 my $q = shift;
d4315dd6 252 my $tid = threads->tid();
385d56e4
JH
253 my $other = 9;
254
18b9e6f5 255 th_start($q);
385d56e4 256 threads->detach();
18b9e6f5
JH
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
JH
260 $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
261 th_done($q);
385d56e4
JH
262}
263
18b9e6f5
JH
264sub th9
265{
266 my $q = shift;
267 th_start($q);
385d56e4 268 sleep(1);
18b9e6f5 269 th_done($q);
385d56e4
JH
270 return (threads->tid());
271}
272
273
18b9e6f5
JH
274sub th13
275{
276 my $q = shift;
d4315dd6 277 my $tid = threads->tid();
385d56e4
JH
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
JH
286 $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
287 th_done($q);
385d56e4
JH
288}
289
18b9e6f5
JH
290sub th11
291{
292 my $q = shift;
293 th_start($q);
294 th_done($q);
385d56e4
JH
295 return (threads->tid());
296}
297
298
18b9e6f5
JH
299sub th17
300{
301 my $q = shift;
d4315dd6 302 my $tid = threads->tid();
385d56e4
JH
303 my $other = 15;
304
18b9e6f5 305 th_start($q);
385d56e4 306 threads->detach();
18b9e6f5
JH
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
JH
310 $q->enqueue($ret == $other, "Thread $tid saw that thread $other returned $ret");
311 th_done($q);
385d56e4
JH
312}
313
18b9e6f5
JH
314sub th15
315{
316 my $q = shift;
317 th_start($q);
385d56e4 318 sleep(1);
18b9e6f5 319 th_done($q);
385d56e4
JH
320 return (threads->tid());
321}
322
323
385d56e4
JH
324TEST_STARTS_HERE:
325{
326 $COUNT = 0;
18b9e6f5 327 threads->create('th1', $q);
385d56e4
JH
328 {
329 lock($COUNT);
330 while ($COUNT < 17) {
331 cond_wait($COUNT);
18b9e6f5 332 ok(); # Prints out any intermediate results
385d56e4
JH
333 }
334 }
385d56e4
JH
335 sleep(1);
336}
337ok($COUNT == 17, "Done - $COUNT threads");
338
339# EOF