ext/threads/shared/t/cond.t

   1 use warnings;
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     push @INC ,'../lib';
   6     require Config; import Config;
   7     unless ($Config{'useithreads'}) {
   8         print "1..0 # Skip: no threads\n";
   9         exit 0;
  10     }
  11 }
  12 $|++;
  13 print "1..25\n";
  14 use strict;
  15
  16
  17 use threads;
  18
  19 use threads::shared;
  20
  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.
  25
  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";
  32 }
  33
  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;
 132 }
 133
 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