1 # cond_wait and cond_timedwait extended tests
9 require Config; import Config;
10 unless ($Config{'useithreads'}) {
11 print "1..0 # Skip: no threads\n";
21 use ExtUtils::testlib;
26 my ($offset, $bool, $text) = @_;
28 $not = "not " unless $bool;
29 print "${not}ok " . ($Base + $offset) . " - $text\n";
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.
36 *forko = ($^O =~ /^dos|os2|mswin32|netware|vms$/i)
37 ? sub (&$$) { my $code = shift; goto &$code; }
39 my ($code, $expected, $patience) = @_;
47 unless (defined($pid = open(CHLD, "-|"))) {
50 if (! $pid) { # Child -- run the test
58 $expected--, $test_num=$1 if /^(?:not )?ok (\d+)/;
59 #print "#forko: ($expected, $1) $_";
67 print "not ok $test_num - child status $?\n";
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 '\[$@%]$;\[$@%]'|);
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)
92 my $test : shared; # simple|repeat|twain
96 print "# testing my \$var : shared\n";
97 ok(1, 1, "Shared synchronization tests preparation");
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
110 ok(4,1,"$test: child signalled condition");
115 foreach (@wait_how) {
116 $test = "cond_wait [$_]";
117 threads->create(\&cw)->join;
125 { # -- begin lock scope; which lock to obtain?
126 $test =~ /twain/ ? lock($lock) : lock($cond);
127 ok(1,1, "$test: obtained initial lock");
129 $thr = threads->create(\&signaller);
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";
136 ok(5,1, "$test: condition obtained");
137 } # -- end lock scope
140 ok(6,1, "$test: join completed");
143 # - TEST cond_timedwait success
146 foreach (@wait_how) {
147 $test = "cond_timedwait [$_]";
148 threads->create(\&ctw, 5)->join;
157 { # -- begin lock scope; which lock to obtain?
158 $test =~ /twain/ ? lock($lock) : lock($cond);
159 ok(1,1, "$test: obtained initial lock");
161 $thr = threads->create(\&signaller);
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";
169 ok(5,$ok, "$test: condition obtained");
170 } # -- end lock scope
173 ok(6,1, "$test: join completed");
176 # - TEST cond_timedwait timeout
179 foreach (@wait_how) {
180 $test = "cond_timedwait pause, timeout [$_]";
181 threads->create(\&ctw_fail, 3)->join;
187 foreach (@wait_how) {
188 $test = "cond_timedwait instant timeout [$_]";
189 threads->create(\&ctw_fail, -60)->join;
194 # cond_timedwait timeout (relative timeout)
198 $test =~ /twain/ ? lock($lock) : lock($cond);
199 ok(1,1, "$test: obtained initial lock");
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";
207 ok(2,!defined($ok), "$test: timeout");
210 } # -- SYNCH_SHARED block
213 # same as above, but with references to lock and cond vars
216 my $test : shared; # simple|repeat|twain
218 my $true_cond; share($true_cond);
219 my $true_lock; share($true_lock);
221 my $cond = \$true_cond;
222 my $lock = \$true_lock;
224 print "# testing reference to shared(\$var)\n";
225 ok(1, 1, "Synchronization reference tests preparation");
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
238 ok(4,1,"$test: child signalled condition");
243 foreach (@wait_how) {
244 $test = "cond_wait [$_]";
245 threads->create(\&cw2)->join;
253 { # -- begin lock scope; which lock to obtain?
254 $test =~ /twain/ ? lock($lock) : lock($cond);
255 ok(1,1, "$test: obtained initial lock");
257 $thr = threads->create(\&signaller2);
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";
264 ok(5,1, "$test: condition obtained");
265 } # -- end lock scope
268 ok(6,1, "$test: join completed");
271 # - TEST cond_timedwait success
274 foreach (@wait_how) {
275 $test = "cond_timedwait [$_]";
276 threads->create(\&ctw2, 5)->join;
285 { # -- begin lock scope; which lock to obtain?
286 $test =~ /twain/ ? lock($lock) : lock($cond);
287 ok(1,1, "$test: obtained initial lock");
289 $thr = threads->create(\&signaller2);
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";
297 ok(5,$ok, "$test: condition obtained");
298 } # -- end lock scope
301 ok(6,1, "$test: join completed");
304 # - TEST cond_timedwait timeout
307 foreach (@wait_how) {
308 $test = "cond_timedwait pause, timeout [$_]";
309 threads->create(\&ctw_fail2, 3)->join;
315 foreach (@wait_how) {
316 $test = "cond_timedwait instant timeout [$_]";
317 threads->create(\&ctw_fail2, -60)->join;
325 $test =~ /twain/ ? lock($lock) : lock($cond);
326 ok(1,1, "$test: obtained initial lock");
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";
334 ok(2,!$ok, "$test: timeout");
337 } # -- SYNCH_REFS block