Commit | Line | Data |
a0e036c1 |
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 | $|++; |
ee23bc3a |
16 | print "1..102\n"; |
a0e036c1 |
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 | |
87c9b3a6 |
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 | |
a0e036c1 |
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 | |
ee23bc3a |
96 | print "# testing my \$var : shared\n"; |
a0e036c1 |
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 |
87c9b3a6 |
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); |
a0e036c1 |
121 | |
122 | sub cw { |
ee23bc3a |
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 |
a0e036c1 |
138 | |
a0e036c1 |
139 | $thr->join; |
ee23bc3a |
140 | ok(6,1, "$test: join completed"); |
a0e036c1 |
141 | } |
142 | |
143 | # - TEST cond_timedwait success |
144 | |
87c9b3a6 |
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); |
a0e036c1 |
152 | |
153 | sub ctw($) { |
154 | my $to = shift; |
ee23bc3a |
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 |
a0e036c1 |
171 | |
a0e036c1 |
172 | $thr->join; |
ee23bc3a |
173 | ok(6,1, "$test: join completed"); |
a0e036c1 |
174 | } |
175 | |
176 | # - TEST cond_timedwait timeout |
177 | |
87c9b3a6 |
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); |
a0e036c1 |
185 | |
87c9b3a6 |
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); |
a0e036c1 |
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 | |
ee23bc3a |
224 | print "# testing reference to shared(\$var)\n"; |
a0e036c1 |
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 |
87c9b3a6 |
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); |
a0e036c1 |
249 | |
250 | sub cw2 { |
ee23bc3a |
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 |
a0e036c1 |
266 | |
a0e036c1 |
267 | $thr->join; |
ee23bc3a |
268 | ok(6,1, "$test: join completed"); |
a0e036c1 |
269 | } |
270 | |
271 | # - TEST cond_timedwait success |
272 | |
87c9b3a6 |
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); |
a0e036c1 |
280 | |
281 | sub ctw2($) { |
282 | my $to = shift; |
ee23bc3a |
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 |
a0e036c1 |
299 | |
a0e036c1 |
300 | $thr->join; |
ee23bc3a |
301 | ok(6,1, "$test: join completed"); |
a0e036c1 |
302 | } |
303 | |
304 | # - TEST cond_timedwait timeout |
305 | |
87c9b3a6 |
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); |
a0e036c1 |
313 | |
87c9b3a6 |
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); |
a0e036c1 |
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 | |