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..31\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     # broad(N) forks off broad(N-1) and goes into a wait, in such a way
 195     # that it's guaranteed to reach the wait before its child enters the
 196     # locked region. When N reaches 0, the child instead does a
 197     # cond_broadcast to wake all its ancestors.
 198
 199     sub broad {
 200         my $n = shift;
 201         my $th;
 202         {
 203             lock($counter);
 204             if ($n > 0) {
 205                 $counter++;
 206                 $th = threads->new(\&broad, $n-1);
 207                 cond_wait($counter);
 208                 $counter += 10;
 209             }
 210             else {
 211                 ok(1, $counter == 3, "cond_broadcast: all three waiting");
 212                 cond_broadcast($counter);
 213             }
 214         }
 215         $th->join if $th;
 216     }
 217
 218     threads->new(\&broad, 3)->join;
 219     ok(2, $counter == 33, "cond_broadcast: all three threads woken");
 220     print "# counter=$counter\n";
 221
 222     $Base += 2;
 223
 224
 225     # ditto, but with refs and shared()
 226
 227     my $counter2 = 0;
 228     share($counter2);
 229     my $r = \$counter2;
 230
 231     sub broad2 {
 232         my $n = shift;
 233         my $th;
 234         {
 235             lock($r);
 236             if ($n > 0) {
 237                 $$r++;
 238                 $th = threads->new(\&broad2, $n-1);
 239                 cond_wait($r);
 240                 $$r += 10;
 241             }
 242             else {
 243                 ok(1, $$r == 3, "cond_broadcast: ref: all three waiting");
 244                 cond_broadcast($r);
 245             }
 246         }
 247         $th->join if $th;
 248     }
 249
 250     threads->new(\&broad2, 3)->join;;
 251     ok(2, $$r == 33, "cond_broadcast: ref: all three threads woken");
 252     print "# counter=$$r\n";
 253
 254     $Base += 2;
 255
 256 }
 257
 258 # test warnings;
 259
 260 {
 261     my $warncount = 0;
 262     local $SIG{__WARN__} = sub { $warncount++ };
 263
 264     my $lock : shared;
 265
 266     cond_signal($lock);
 267     ok(1, $warncount == 1, 'get warning on cond_signal');
 268     cond_broadcast($lock);
 269     ok(2, $warncount == 2, 'get warning on cond_broadcast');
 270     no warnings 'threads';
 271     cond_signal($lock);
 272     ok(3, $warncount == 2, 'get no warning on cond_signal');
 273     cond_broadcast($lock);
 274     ok(4, $warncount == 2, 'get no warning on cond_broadcast');
 275
 276     $Base += 4;
 277 }
 278
 279
 280