Commit | Line | Data |
13c1b207 |
1 | use warnings; |
2 | |
89661126 |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
b5135157 |
5 | push @INC ,'../lib'; |
89661126 |
6 | require Config; import Config; |
7 | unless ($Config{'useithreads'}) { |
8 | print "1..0 # Skip: no threads\n"; |
9 | exit 0; |
10 | } |
11 | } |
cd055192 |
12 | $|++; |
48eb4d6f |
13 | print "1..25\n"; |
89661126 |
14 | use strict; |
15 | |
b5135157 |
16 | |
89661126 |
17 | use threads; |
18 | |
19 | use threads::shared; |
20 | |
ab335022 |
21 | # We can't use the normal ok() type stuff here, as part of the test is |
22 | # to check that the numbers get printed in the right order. Instead, we |
23 | # set a 'base' number for each part of the test and specify the ok() |
24 | # number as an offset from that base. |
89661126 |
25 | |
ab335022 |
26 | my $Base = 0; |
27 | |
28 | sub ok { |
29 | my ($offset, $bool, $text) = @_; |
30 | print "not " unless $bool; |
31 | print "ok ", $Base + $offset, " - $text\n"; |
89661126 |
32 | } |
33 | |
ab335022 |
34 | # test locking |
35 | |
36 | { |
37 | my $lock : shared; |
38 | my $tr; |
39 | |
40 | # test that a subthread can't lock until parent thread has unlocked |
41 | |
42 | { |
43 | lock($lock); |
44 | ok(1,1,"set first lock"); |
45 | $tr = async { |
46 | lock($lock); |
47 | ok(3,1,"set lock in subthread"); |
48 | }; |
49 | threads->yield; |
50 | ok(2,1,"still got lock"); |
51 | } |
52 | $tr->join; |
53 | |
54 | $Base += 3; |
55 | |
56 | # ditto with ref to thread |
57 | |
58 | { |
59 | my $lockref = \$lock; |
60 | lock($lockref); |
61 | ok(1,1,"set first lockref"); |
62 | $tr = async { |
63 | lock($lockref); |
64 | ok(3,1,"set lockref in subthread"); |
65 | }; |
66 | threads->yield; |
67 | ok(2,1,"still got lockref"); |
68 | } |
69 | $tr->join; |
70 | |
71 | $Base += 3; |
72 | |
73 | # make sure recursive locks unlock at the right place |
74 | { |
75 | lock($lock); |
76 | ok(1,1,"set first recursive lock"); |
77 | lock($lock); |
78 | threads->yield; |
79 | { |
80 | lock($lock); |
81 | threads->yield; |
82 | } |
83 | $tr = async { |
84 | lock($lock); |
85 | ok(3,1,"set recursive lock in subthread"); |
86 | }; |
87 | { |
88 | lock($lock); |
89 | threads->yield; |
90 | { |
91 | lock($lock); |
92 | threads->yield; |
93 | lock($lock); |
94 | threads->yield; |
95 | } |
96 | } |
97 | ok(2,1,"still got recursive lock"); |
98 | } |
99 | $tr->join; |
100 | |
101 | $Base += 3; |
102 | |
103 | # Make sure a lock factory gives out fresh locks each time |
104 | # for both attribute and run-time shares |
105 | |
106 | sub lock_factory1 { my $lock : shared; return \$lock; } |
107 | sub lock_factory2 { my $lock; share($lock); return \$lock; } |
108 | |
109 | my (@locks1, @locks2); |
110 | push @locks1, lock_factory1() for 1..2; |
111 | push @locks1, lock_factory2() for 1..2; |
112 | push @locks2, lock_factory1() for 1..2; |
113 | push @locks2, lock_factory2() for 1..2; |
114 | |
115 | ok(1,1,"lock factory: locking all locks"); |
116 | lock $locks1[0]; |
117 | lock $locks1[1]; |
118 | lock $locks1[2]; |
119 | lock $locks1[3]; |
120 | ok(2,1,"lock factory: locked all locks"); |
121 | $tr = async { |
122 | ok(3,1,"lock factory: child: locking all locks"); |
123 | lock $locks2[0]; |
124 | lock $locks2[1]; |
125 | lock $locks2[2]; |
126 | lock $locks2[3]; |
127 | ok(4,1,"lock factory: child: locked all locks"); |
128 | }; |
129 | $tr->join; |
130 | |
131 | $Base += 4; |
89661126 |
132 | } |
133 | |
ab335022 |
134 | # test cond_signal() |
135 | |
136 | { |
137 | my $lock : shared; |
138 | |
139 | sub foo { |
140 | lock($lock); |
141 | ok(1,1,"cond_signal: created first lock"); |
142 | my $tr2 = threads->create(\&bar); |
143 | cond_wait($lock); |
144 | $tr2->join(); |
145 | ok(5,1,"cond_signal: joined"); |
146 | } |
147 | |
148 | sub bar { |
149 | ok(2,1,"cond_signal: child before lock"); |
150 | lock($lock); |
151 | ok(3,1,"cond_signal: child locked"); |
152 | cond_signal($lock); |
153 | ok(4,1,"cond_signal: signalled"); |
154 | } |
155 | |
156 | my $tr = threads->create(\&foo); |
157 | $tr->join(); |
158 | |
159 | $Base += 5; |
160 | |
161 | # ditto, but with lockrefs |
162 | |
163 | my $lockref = \$lock; |
164 | sub foo2 { |
165 | lock($lockref); |
166 | ok(1,1,"cond_signal: ref: created first lock"); |
167 | my $tr2 = threads->create(\&bar2); |
168 | cond_wait($lockref); |
169 | $tr2->join(); |
170 | ok(5,1,"cond_signal: ref: joined"); |
171 | } |
172 | |
173 | sub bar2 { |
174 | ok(2,1,"cond_signal: ref: child before lock"); |
175 | lock($lockref); |
176 | ok(3,1,"cond_signal: ref: child locked"); |
177 | cond_signal($lockref); |
178 | ok(4,1,"cond_signal: ref: signalled"); |
179 | } |
180 | |
181 | $tr = threads->create(\&foo2); |
182 | $tr->join(); |
183 | |
184 | $Base += 5; |
185 | |
186 | } |
187 | |
188 | |
189 | # test cond_broadcast() |
190 | |
191 | { |
192 | my $counter : shared = 0; |
193 | |
194 | sub waiter { |
195 | lock($counter); |
196 | $counter++; |
197 | cond_wait($counter); |
198 | $counter += 10; |
199 | } |
200 | |
201 | my $tr1 = threads->new(\&waiter); |
202 | my $tr2 = threads->new(\&waiter); |
203 | my $tr3 = threads->new(\&waiter); |
204 | |
205 | while (1) { |
206 | lock $counter; |
207 | # make sure all 3 threads are waiting |
208 | next unless $counter == 3; |
209 | cond_broadcast $counter; |
210 | last; |
211 | } |
212 | $tr1->join(); $tr2->join(); $tr3->join(); |
213 | ok(1, $counter == 33, "cond_broadcast: all three threads woken"); |
214 | print "# counter=$counter\n"; |
215 | |
216 | $Base += 1; |
217 | |
218 | # ditto with refs and shared() |
219 | |
220 | my $counter2; |
221 | share($counter2); |
222 | my $r = \$counter2; |
223 | |
224 | sub waiter2 { |
225 | lock($r); |
226 | $$r++; |
227 | cond_wait($r); |
228 | $$r += 10; |
229 | } |
230 | |
231 | $tr1 = threads->new(\&waiter2); |
232 | $tr2 = threads->new(\&waiter2); |
233 | $tr3 = threads->new(\&waiter2); |
234 | |
235 | while (1) { |
236 | lock($r); |
237 | # make sure all 3 threads are waiting |
238 | next unless $$r == 3; |
239 | cond_broadcast $r; |
240 | last; |
241 | } |
242 | $tr1->join(); $tr2->join(); $tr3->join(); |
243 | ok(1, $$r == 33, "cond_broadcast: ref: all three threads woken"); |
244 | print "# counter=$$r\n"; |
245 | |
246 | $Base += 1; |
247 | |
248 | } |
249 | |