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 | $|++; |
16 | print "1..90\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 | # - TEST basics |
33 | |
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 '\[$@%]$;\[$@%]'|); |
40 | |
41 | $Base += 4; |
42 | |
43 | my @wait_how = ( |
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) |
47 | ); |
48 | |
49 | SYNC_SHARED: { |
50 | my $test : shared; # simple|repeat|twain |
51 | my $cond : shared; |
52 | my $lock : shared; |
53 | |
54 | ok(1, 1, "Shared synchronization tests preparation"); |
55 | $Base += 1; |
56 | |
57 | sub signaller { |
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 |
63 | cond_signal($cond); |
64 | } else { |
65 | cond_signal($cond); |
66 | } |
67 | ok(4,1,"$test: child signalled condition"); |
68 | } |
69 | |
70 | # - TEST cond_wait |
71 | foreach (@wait_how) { |
72 | $test = "cond_wait [$_]"; |
73 | threads->create(\&cw)->join; |
74 | $Base += 5; |
75 | } |
76 | |
77 | sub cw { |
78 | ## which lock to obtain in this scope? |
79 | $test =~ /twain/ ? lock($lock) : lock($cond); |
80 | ok(1,1, "$test: obtained initial lock"); |
81 | |
82 | my $thr = threads->create(\&signaller); |
83 | for ($test) { |
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"; |
88 | } |
89 | $thr->join; |
90 | ok(5,1, "$test: condition obtained"); |
91 | } |
92 | |
93 | # - TEST cond_timedwait success |
94 | |
95 | foreach (@wait_how) { |
96 | $test = "cond_timedwait [$_]"; |
97 | threads->create(\&ctw, 5)->join; |
98 | $Base += 5; |
99 | } |
100 | |
101 | sub ctw($) { |
102 | my $to = shift; |
103 | |
104 | ## which lock to obtain in this scope? |
105 | $test =~ /twain/ ? lock($lock) : lock($cond); |
106 | ok(1,1, "$test: obtained initial lock"); |
107 | |
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. |
114 | my $ok = 0; |
115 | for ($test) { |
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"; |
120 | } |
121 | print "# back from cond_timedwait; join()ing\n"; |
122 | $thr->join; |
123 | ok(5,$ok, "$test: condition obtained"); |
124 | } |
125 | |
126 | # - TEST cond_timedwait timeout |
127 | |
128 | foreach (@wait_how) { |
129 | $test = "cond_timedwait pause, timeout [$_]"; |
130 | threads->create(\&ctw_fail, 3)->join; |
131 | $Base += 2; |
132 | } |
133 | |
134 | foreach (@wait_how) { |
135 | $test = "cond_timedwait instant timeout [$_]"; |
136 | threads->create(\&ctw_fail, -60)->join; |
137 | $Base += 2; |
138 | } |
139 | |
140 | # cond_timedwait timeout (relative timeout) |
141 | sub ctw_fail { |
142 | my $to = shift; |
143 | |
144 | $test =~ /twain/ ? lock($lock) : lock($cond); |
145 | ok(1,1, "$test: obtained initial lock"); |
146 | my $ok; |
147 | for ($test) { |
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"; |
152 | } |
153 | ok(2,!defined($ok), "$test: timeout"); |
154 | } |
155 | |
156 | } # -- SYNCH_SHARED block |
157 | |
158 | |
159 | # same as above, but with references to lock and cond vars |
160 | |
161 | SYNCH_REFS: { |
162 | my $test : shared; # simple|repeat|twain |
163 | |
164 | my $true_cond; share($true_cond); |
165 | my $true_lock; share($true_lock); |
166 | |
167 | my $cond = \$true_cond; |
168 | my $lock = \$true_lock; |
169 | |
170 | ok(1, 1, "Synchronization reference tests preparation"); |
171 | $Base += 1; |
172 | |
173 | sub signaller2 { |
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 |
179 | cond_signal($cond); |
180 | } else { |
181 | cond_signal($cond); |
182 | } |
183 | ok(4,1,"$test: child signalled condition"); |
184 | } |
185 | |
186 | # - TEST cond_wait |
187 | foreach (@wait_how) { |
188 | $test = "cond_wait [$_]"; |
189 | threads->create(\&cw2)->join; |
190 | $Base += 5; |
191 | } |
192 | |
193 | sub cw2 { |
194 | ## which lock to obtain in this scope? |
195 | $test =~ /twain/ ? lock($lock) : lock($cond); |
196 | ok(1,1, "$test: obtained initial lock"); |
197 | |
198 | my $thr = threads->create(\&signaller2); |
199 | for ($test) { |
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"; |
204 | } |
205 | $thr->join; |
206 | ok(5,1, "$test: condition obtained"); |
207 | } |
208 | |
209 | # - TEST cond_timedwait success |
210 | |
211 | foreach (@wait_how) { |
212 | $test = "cond_timedwait [$_]"; |
213 | threads->create(\&ctw2, 5)->join; |
214 | $Base += 5; |
215 | } |
216 | |
217 | sub ctw2($) { |
218 | my $to = shift; |
219 | |
220 | ## which lock to obtain in this scope? |
221 | $test =~ /twain/ ? lock($lock) : lock($cond); |
222 | ok(1,1, "$test: obtained initial lock"); |
223 | |
224 | my $thr = threads->create(\&signaller2); |
225 | ### N.B.: RACE! as above, with ctw() |
226 | my $ok = 0; |
227 | for ($test) { |
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"; |
232 | } |
233 | $thr->join; |
234 | ok(5,$ok, "$test: condition obtained"); |
235 | } |
236 | |
237 | # - TEST cond_timedwait timeout |
238 | |
239 | foreach (@wait_how) { |
240 | $test = "cond_timedwait pause, timeout [$_]"; |
241 | threads->create(\&ctw_fail2, 3)->join; |
242 | $Base += 2; |
243 | } |
244 | |
245 | foreach (@wait_how) { |
246 | $test = "cond_timedwait instant timeout [$_]"; |
247 | threads->create(\&ctw_fail2, -60)->join; |
248 | $Base += 2; |
249 | } |
250 | |
251 | sub ctw_fail2 { |
252 | my $to = shift; |
253 | |
254 | $test =~ /twain/ ? lock($lock) : lock($cond); |
255 | ok(1,1, "$test: obtained initial lock"); |
256 | my $ok; |
257 | for ($test) { |
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"; |
262 | } |
263 | ok(2,!$ok, "$test: timeout"); |
264 | } |
265 | |
266 | } # -- SYNCH_REFS block |
267 | |