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";
34 ok(1, defined &cond_wait, "cond_wait() present");
35 ok(2, (prototype(\&cond_wait) eq '\[$@%];\[$@%]'),
36 q|cond_wait() prototype '\[$@%];\[$@%]'|);
37 ok(3, defined &cond_timedwait, "cond_timedwait() present");
38 ok(4, (prototype(\&cond_timedwait) eq '\[$@%]$;\[$@%]'),
39 q|cond_timedwait() prototype '\[$@%]$;\[$@%]'|);
44 "simple", # cond var == lock var; implicit lock; e.g.: cond_wait($c)
45 "repeat", # cond var == lock var; explicit lock; e.g.: cond_wait($c, $c)
46 "twain" # cond var != lock var; explicit lock; e.g.: cond_wait($c, $l)
50 my $test : shared; # simple|repeat|twain
54 ok(1, 1, "Shared synchronization tests preparation");
58 ok(2,1,"$test: child before lock");
59 $test =~ /twain/ ? lock($lock) : lock($cond);
60 ok(3,1,"$test: child obtained lock");
61 if ($test =~ 'twain') {
62 no warnings 'threads'; # lock var != cond var, so disable warnings
67 ok(4,1,"$test: child signalled condition");
72 $test = "cond_wait [$_]";
73 threads->create(\&cw)->join;
78 ## which lock to obtain in this scope?
79 $test =~ /twain/ ? lock($lock) : lock($cond);
80 ok(1,1, "$test: obtained initial lock");
82 my $thr = threads->create(\&signaller);
84 cond_wait($cond), last if /simple/;
85 cond_wait($cond, $cond), last if /repeat/;
86 cond_wait($cond, $lock), last if /twain/;
87 die "$test: unknown test\n";
90 ok(5,1, "$test: condition obtained");
93 # - TEST cond_timedwait success
96 $test = "cond_timedwait [$_]";
97 threads->create(\&ctw, 5)->join;
104 ## which lock to obtain in this scope?
105 $test =~ /twain/ ? lock($lock) : lock($cond);
106 ok(1,1, "$test: obtained initial lock");
108 my $thr = threads->create(\&signaller);
109 ### N.B.: RACE! If $timeout is very soon and/or we are unlucky, we
110 ### might timeout on the cond_timedwait before the signaller
111 ### thread even attempts lock()ing.
112 ### Upshot: $thr->join() never completes, because signaller is
113 ### stuck attempting to lock the mutex we regained after waiting.
116 $ok=cond_timedwait($cond, time() + $to), last if /simple/;
117 $ok=cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
118 $ok=cond_timedwait($cond, time() + $to, $lock), last if /twain/;
119 die "$test: unknown test\n";
121 print "# back from cond_timedwait; join()ing\n";
123 ok(5,$ok, "$test: condition obtained");
126 # - TEST cond_timedwait timeout
128 foreach (@wait_how) {
129 $test = "cond_timedwait pause, timeout [$_]";
130 threads->create(\&ctw_fail, 3)->join;
134 foreach (@wait_how) {
135 $test = "cond_timedwait instant timeout [$_]";
136 threads->create(\&ctw_fail, -60)->join;
140 # cond_timedwait timeout (relative timeout)
144 $test =~ /twain/ ? lock($lock) : lock($cond);
145 ok(1,1, "$test: obtained initial lock");
148 $ok=cond_timedwait($cond, time() + $to), last if /simple/;
149 $ok=cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
150 $ok=cond_timedwait($cond, time() + $to, $lock), last if /twain/;
151 die "$test: unknown test\n";
153 ok(2,!defined($ok), "$test: timeout");
156 } # -- SYNCH_SHARED block
159 # same as above, but with references to lock and cond vars
162 my $test : shared; # simple|repeat|twain
164 my $true_cond; share($true_cond);
165 my $true_lock; share($true_lock);
167 my $cond = \$true_cond;
168 my $lock = \$true_lock;
170 ok(1, 1, "Synchronization reference tests preparation");
174 ok(2,1,"$test: child before lock");
175 $test =~ /twain/ ? lock($lock) : lock($cond);
176 ok(3,1,"$test: child obtained lock");
177 if ($test =~ 'twain') {
178 no warnings 'threads'; # lock var != cond var, so disable warnings
183 ok(4,1,"$test: child signalled condition");
187 foreach (@wait_how) {
188 $test = "cond_wait [$_]";
189 threads->create(\&cw2)->join;
194 ## which lock to obtain in this scope?
195 $test =~ /twain/ ? lock($lock) : lock($cond);
196 ok(1,1, "$test: obtained initial lock");
198 my $thr = threads->create(\&signaller2);
200 cond_wait($cond), last if /simple/;
201 cond_wait($cond, $cond), last if /repeat/;
202 cond_wait($cond, $lock), last if /twain/;
203 die "$test: unknown test\n";
206 ok(5,1, "$test: condition obtained");
209 # - TEST cond_timedwait success
211 foreach (@wait_how) {
212 $test = "cond_timedwait [$_]";
213 threads->create(\&ctw2, 5)->join;
220 ## which lock to obtain in this scope?
221 $test =~ /twain/ ? lock($lock) : lock($cond);
222 ok(1,1, "$test: obtained initial lock");
224 my $thr = threads->create(\&signaller2);
225 ### N.B.: RACE! as above, with ctw()
228 $ok=cond_timedwait($cond, time() + $to), last if /simple/;
229 $ok=cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
230 $ok=cond_timedwait($cond, time() + $to, $lock), last if /twain/;
231 die "$test: unknown test\n";
234 ok(5,$ok, "$test: condition obtained");
237 # - TEST cond_timedwait timeout
239 foreach (@wait_how) {
240 $test = "cond_timedwait pause, timeout [$_]";
241 threads->create(\&ctw_fail2, 3)->join;
245 foreach (@wait_how) {
246 $test = "cond_timedwait instant timeout [$_]";
247 threads->create(\&ctw_fail2, -60)->join;
254 $test =~ /twain/ ? lock($lock) : lock($cond);
255 ok(1,1, "$test: obtained initial lock");
258 $ok=cond_timedwait($cond, time() + $to), last if /simple/;
259 $ok=cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
260 $ok=cond_timedwait($cond, time() + $to, $lock), last if /twain/;
261 die "$test: unknown test\n";
263 ok(2,!$ok, "$test: timeout");
266 } # -- SYNCH_REFS block