6 require Config; import Config;
7 unless ($Config{'useithreads'}) {
8 print "1..0 # Skip: no threads\n";
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.
29 my ($offset, $bool, $text) = @_;
30 print "not " unless $bool;
31 print "ok ", $Base + $offset, " - $text\n";
40 # test that a subthread can't lock until parent thread has unlocked
44 ok(1,1,"set first lock");
47 ok(3,1,"set lock in subthread");
50 ok(2,1,"still got lock");
56 # ditto with ref to thread
61 ok(1,1,"set first lockref");
64 ok(3,1,"set lockref in subthread");
67 ok(2,1,"still got lockref");
73 # make sure recursive locks unlock at the right place
76 ok(1,1,"set first recursive lock");
85 ok(3,1,"set recursive lock in subthread");
97 ok(2,1,"still got recursive lock");
103 # Make sure a lock factory gives out fresh locks each time
104 # for both attribute and run-time shares
106 sub lock_factory1 { my $lock : shared; return \$lock; }
107 sub lock_factory2 { my $lock; share($lock); return \$lock; }
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;
115 ok(1,1,"lock factory: locking all locks");
120 ok(2,1,"lock factory: locked all locks");
122 ok(3,1,"lock factory: child: locking all locks");
127 ok(4,1,"lock factory: child: locked all locks");
141 ok(1,1,"cond_signal: created first lock");
142 my $tr2 = threads->create(\&bar);
145 ok(5,1,"cond_signal: joined");
149 ok(2,1,"cond_signal: child before lock");
151 ok(3,1,"cond_signal: child locked");
153 ok(4,1,"cond_signal: signalled");
156 my $tr = threads->create(\&foo);
161 # ditto, but with lockrefs
163 my $lockref = \$lock;
166 ok(1,1,"cond_signal: ref: created first lock");
167 my $tr2 = threads->create(\&bar2);
170 ok(5,1,"cond_signal: ref: joined");
174 ok(2,1,"cond_signal: ref: child before lock");
176 ok(3,1,"cond_signal: ref: child locked");
177 cond_signal($lockref);
178 ok(4,1,"cond_signal: ref: signalled");
181 $tr = threads->create(\&foo2);
189 # test cond_broadcast()
192 my $counter : shared = 0;
201 my $tr1 = threads->new(\&waiter);
202 my $tr2 = threads->new(\&waiter);
203 my $tr3 = threads->new(\&waiter);
207 # make sure all 3 threads are waiting
208 next unless $counter == 3;
209 cond_broadcast $counter;
212 $tr1->join(); $tr2->join(); $tr3->join();
213 ok(1, $counter == 33, "cond_broadcast: all three threads woken");
214 print "# counter=$counter\n";
218 # ditto with refs and shared()
231 $tr1 = threads->new(\&waiter2);
232 $tr2 = threads->new(\&waiter2);
233 $tr3 = threads->new(\&waiter2);
237 # make sure all 3 threads are waiting
238 next unless $$r == 3;
242 $tr1->join(); $tr2->join(); $tr3->join();
243 ok(1, $$r == 33, "cond_broadcast: ref: all three threads woken");
244 print "# counter=$$r\n";
254 local $SIG{__WARN__} = sub { $warncount++ };
259 ok(1, $warncount == 1, 'get warning on cond_signal');
260 cond_broadcast($lock);
261 ok(2, $warncount == 2, 'get warning on cond_broadcast');
262 no warnings 'threads';
264 ok(3, $warncount == 2, 'get no warning on cond_signal');
265 cond_broadcast($lock);
266 ok(4, $warncount == 2, 'get no warning on cond_broadcast');