This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[ANNOUNCE] Math::BigInt v1.69
[perl5.git] / ext / threads / shared / t / wait.t
1 # cond_wait and cond_timedwait extended tests
2 # adapted from cond.t
3
4 use warnings;
5
6 BEGIN {
7     chdir 't' if -d 't';
8     push @INC ,'../lib';
9     require Config; import Config;
10     unless ($Config{'useithreads'}) {
11         print "1..0 # Skip: no threads\n";
12         exit 0;
13     }
14 }
15 $|++;
16 print "1..102\n";
17 use strict;
18
19 use threads;
20 use threads::shared;
21 use ExtUtils::testlib;
22
23 my $Base = 0;
24
25 sub ok {
26     my ($offset, $bool, $text) = @_;
27     my $not = '';
28     $not = "not " unless $bool;
29     print "${not}ok " . ($Base + $offset) . " - $text\n";
30 }
31
32 sub forko (&$$); # To prevent deadlock from underlying pthread_* bugs (as in
33                  # stock RH9 glibc/NPTL) or from our own errors, we run tests
34                  # in separately forked and alarmed processes.
35
36 *forko = ($^O =~ /^dos|os2|mswin32|netware$/i)  # Not on DOSish platforms
37 ? sub (&$$) { my $code = shift; goto &$code; }
38 : sub (&$$) {
39   my ($code, $expected, $patience) = @_;
40   my ($test_num, $pid);
41   local *CHLD;
42
43   my $bump = $expected;
44
45   $patience ||= 60;
46
47   unless (defined($pid = open(CHLD, "-|"))) {
48     die "fork: $!\n";
49   }
50   if (! $pid) {   # Child -- run the test
51     $patience ||= 60;
52     alarm $patience;
53     &$code;
54     exit;
55   }
56
57   while (<CHLD>) {
58     $expected--, $test_num=$1 if /^(?:not )?ok (\d+)/;
59     #print "#forko: ($expected, $1) $_";
60     print;
61   }
62
63   close(CHLD);
64
65   while ($expected--) {
66     $test_num++;
67     print "not ok $test_num - child status $?\n";
68   }
69
70   $Base += $bump;
71
72 };
73
74 # - TEST basics
75
76 ok(1, defined &cond_wait, "cond_wait() present");
77 ok(2, (prototype(\&cond_wait) eq '\[$@%];\[$@%]'),
78     q|cond_wait() prototype '\[$@%];\[$@%]'|);
79 ok(3, defined &cond_timedwait, "cond_timedwait() present");
80 ok(4, (prototype(\&cond_timedwait) eq '\[$@%]$;\[$@%]'),
81     q|cond_timedwait() prototype '\[$@%]$;\[$@%]'|);
82
83 $Base += 4;
84
85 my @wait_how = (
86    "simple",  # cond var == lock var; implicit lock; e.g.: cond_wait($c)
87    "repeat",  # cond var == lock var; explicit lock; e.g.: cond_wait($c, $c)
88    "twain"    # cond var != lock var; explicit lock; e.g.: cond_wait($c, $l)
89 );
90
91 SYNC_SHARED: {
92   my $test : shared;  # simple|repeat|twain
93   my $cond : shared;
94   my $lock : shared;
95
96   print "# testing my \$var : shared\n";
97   ok(1, 1, "Shared synchronization tests preparation");
98   $Base += 1;
99
100   sub signaller {
101     ok(2,1,"$test: child before lock");
102     $test =~ /twain/ ? lock($lock) : lock($cond);
103     ok(3,1,"$test: child obtained lock");
104     if ($test =~ 'twain') {
105       no warnings 'threads';   # lock var != cond var, so disable warnings
106       cond_signal($cond);
107     } else {
108       cond_signal($cond);
109     }
110     ok(4,1,"$test: child signalled condition");
111   }
112
113   # - TEST cond_wait
114   forko( sub {
115     foreach (@wait_how) {
116       $test = "cond_wait [$_]";
117       threads->create(\&cw)->join;
118       $Base += 6;
119     }
120   }, 6*@wait_how, 90);
121
122   sub cw {
123     my $thr;
124
125     { # -- begin lock scope; which lock to obtain?
126       $test =~ /twain/ ? lock($lock) : lock($cond);
127       ok(1,1, "$test: obtained initial lock");
128
129       $thr = threads->create(\&signaller);
130       for ($test) {
131         cond_wait($cond), last        if    /simple/;
132         cond_wait($cond, $cond), last if    /repeat/;
133         cond_wait($cond, $lock), last if    /twain/;
134         die "$test: unknown test\n"; 
135       }
136       ok(5,1, "$test: condition obtained");
137     } # -- end lock scope
138
139     $thr->join;
140     ok(6,1, "$test: join completed");
141   }
142
143   # - TEST cond_timedwait success
144
145   forko( sub {
146     foreach (@wait_how) {
147       $test = "cond_timedwait [$_]";
148       threads->create(\&ctw, 5)->join;
149       $Base += 6;
150     }
151   }, 6*@wait_how, 90);
152
153   sub ctw($) {
154     my $to = shift;
155     my $thr;
156
157     { # -- begin lock scope;  which lock to obtain?
158       $test =~ /twain/ ? lock($lock) : lock($cond);
159       ok(1,1, "$test: obtained initial lock");
160
161       $thr = threads->create(\&signaller);
162       my $ok = 0;
163       for ($test) {
164         $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
165         $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
166         $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
167         die "$test: unknown test\n"; 
168       }
169       ok(5,$ok, "$test: condition obtained");
170     } # -- end lock scope
171
172     $thr->join;
173     ok(6,1, "$test: join completed");
174   }
175
176   # - TEST cond_timedwait timeout
177
178   forko( sub {
179     foreach (@wait_how) {
180       $test = "cond_timedwait pause, timeout [$_]";
181       threads->create(\&ctw_fail, 3)->join;
182       $Base += 2;
183     }
184   }, 2*@wait_how, 90);
185
186   forko( sub {
187     foreach (@wait_how) {
188       $test = "cond_timedwait instant timeout [$_]";
189       threads->create(\&ctw_fail, -60)->join;
190       $Base += 2;
191     }
192   }, 2*@wait_how, 90);
193
194   # cond_timedwait timeout (relative timeout)
195   sub ctw_fail {
196     my $to = shift;
197
198     $test =~ /twain/ ? lock($lock) : lock($cond);
199     ok(1,1, "$test: obtained initial lock");
200     my $ok;
201     for ($test) {
202       $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
203       $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
204       $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
205       die "$test: unknown test\n"; 
206     }
207     ok(2,!defined($ok), "$test: timeout");
208   }
209
210 } # -- SYNCH_SHARED block
211
212
213 # same as above, but with references to lock and cond vars
214
215 SYNCH_REFS: {
216   my $test : shared;  # simple|repeat|twain
217   
218   my $true_cond; share($true_cond);
219   my $true_lock; share($true_lock);
220
221   my $cond = \$true_cond;
222   my $lock = \$true_lock;
223
224   print "# testing reference to shared(\$var)\n";
225   ok(1, 1, "Synchronization reference tests preparation");
226   $Base += 1;
227
228   sub signaller2 {
229     ok(2,1,"$test: child before lock");
230     $test =~ /twain/ ? lock($lock) : lock($cond);
231     ok(3,1,"$test: child obtained lock");
232     if ($test =~ 'twain') {
233       no warnings 'threads';   # lock var != cond var, so disable warnings
234       cond_signal($cond);
235     } else {
236       cond_signal($cond);
237     }
238     ok(4,1,"$test: child signalled condition");
239   }
240
241   # - TEST cond_wait
242   forko( sub {
243     foreach (@wait_how) {
244       $test = "cond_wait [$_]";
245       threads->create(\&cw2)->join;
246       $Base += 6;
247     }
248   }, 6*@wait_how, 90);
249
250   sub cw2 {
251     my $thr;
252
253     { # -- begin lock scope; which lock to obtain?
254       $test =~ /twain/ ? lock($lock) : lock($cond);
255       ok(1,1, "$test: obtained initial lock");
256
257       $thr = threads->create(\&signaller2);
258       for ($test) {
259         cond_wait($cond), last        if    /simple/;
260         cond_wait($cond, $cond), last if    /repeat/;
261         cond_wait($cond, $lock), last if    /twain/;
262         die "$test: unknown test\n"; 
263       }
264       ok(5,1, "$test: condition obtained");
265     } # -- end lock scope
266
267     $thr->join;
268     ok(6,1, "$test: join completed");
269   }
270
271   # - TEST cond_timedwait success
272
273   forko( sub {
274     foreach (@wait_how) {
275       $test = "cond_timedwait [$_]";
276       threads->create(\&ctw2, 5)->join;
277       $Base += 6;
278     }
279   }, 6*@wait_how, 90);
280
281   sub ctw2($) {
282     my $to = shift;
283     my $thr;
284
285     { # -- begin lock scope;  which lock to obtain?
286       $test =~ /twain/ ? lock($lock) : lock($cond);
287       ok(1,1, "$test: obtained initial lock");
288
289       $thr = threads->create(\&signaller2);
290       my $ok = 0;
291       for ($test) {
292         $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
293         $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
294         $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
295         die "$test: unknown test\n"; 
296       }
297       ok(5,$ok, "$test: condition obtained");
298     } # -- end lock scope
299
300     $thr->join;
301     ok(6,1, "$test: join completed");
302   }
303
304   # - TEST cond_timedwait timeout
305
306   forko( sub {
307     foreach (@wait_how) {
308       $test = "cond_timedwait pause, timeout [$_]";
309       threads->create(\&ctw_fail2, 3)->join;
310       $Base += 2;
311     }
312   }, 2*@wait_how, 90);
313
314   forko( sub {
315     foreach (@wait_how) {
316       $test = "cond_timedwait instant timeout [$_]";
317       threads->create(\&ctw_fail2, -60)->join;
318       $Base += 2;
319     }
320   }, 2*@wait_how, 90);
321
322   sub ctw_fail2 {
323     my $to = shift;
324
325     $test =~ /twain/ ? lock($lock) : lock($cond);
326     ok(1,1, "$test: obtained initial lock");
327     my $ok;
328     for ($test) {
329       $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
330       $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
331       $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
332       die "$test: unknown test\n"; 
333     }
334     ok(2,!$ok, "$test: timeout");
335   }
336
337 } # -- SYNCH_REFS block
338