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     my $not = '';
  31     $not = "not " unless $bool;
  32     print "${not}ok " . ($Base + $offset) . " - $text\n";
  33 }
  34
  35 # test locking
  36
  37 {
  38     my $lock : shared;
  39     my $tr;
  40
  41     # test that a subthread can't lock until parent thread has unlocked
  42
  43     {
  44         lock($lock);
  45         ok(1,1,"set first lock");
  46         $tr = async {
  47             lock($lock);
  48             ok(3,1,"set lock in subthread");
  49         };
  50         threads->yield;
  51         ok(2,1,"still got lock");
  52     }
  53     $tr->join;
  54
  55     $Base += 3;
  56
  57     # ditto with ref to thread
  58
  59     {
  60         my $lockref = \$lock;
  61         lock($lockref);
  62         ok(1,1,"set first lockref");
  63         $tr = async {
  64             lock($lockref);
  65             ok(3,1,"set lockref in subthread");
  66         };
  67         threads->yield;
  68         ok(2,1,"still got lockref");
  69     }
  70     $tr->join;
  71
  72     $Base += 3;
  73
  74     # make sure recursive locks unlock at the right place
  75     {
  76         lock($lock);
  77         ok(1,1,"set first recursive lock");
  78         lock($lock);
  79         threads->yield;
  80         {
  81             lock($lock);
  82             threads->yield;
  83         }
  84         $tr = async {
  85             lock($lock);
  86             ok(3,1,"set recursive lock in subthread");
  87         };
  88         {
  89             lock($lock);
  90             threads->yield;
  91             {
  92                 lock($lock);
  93                 threads->yield;
  94                 lock($lock);
  95                 threads->yield;
  96             }
  97         }
  98         ok(2,1,"still got recursive lock");
  99     }
 100     $tr->join;
 101
 102     $Base += 3;
 103
 104     # Make sure a lock factory gives out fresh locks each time
 105     # for both attribute and run-time shares
 106
 107     sub lock_factory1 { my $lock : shared; return \$lock; }
 108     sub lock_factory2 { my $lock; share($lock); return \$lock; }
 109
 110     my (@locks1, @locks2);
 111     push @locks1, lock_factory1() for 1..2;
 112     push @locks1, lock_factory2() for 1..2;
 113     push @locks2, lock_factory1() for 1..2;
 114     push @locks2, lock_factory2() for 1..2;
 115
 116     ok(1,1,"lock factory: locking all locks");
 117     lock $locks1[0];
 118     lock $locks1[1];
 119     lock $locks1[2];
 120     lock $locks1[3];
 121     ok(2,1,"lock factory: locked all locks");
 122     $tr = async {
 123         ok(3,1,"lock factory: child: locking all locks");
 124         lock $locks2[0];
 125         lock $locks2[1];
 126         lock $locks2[2];
 127         lock $locks2[3];
 128         ok(4,1,"lock factory: child: locked all locks");
 129     };
 130     $tr->join;
 131
 132     $Base += 4;
 133 }
 134
 135 # test cond_signal()
 136
 137 {
 138     my $lock : shared;
 139
 140     sub foo {
 141         lock($lock);
 142         ok(1,1,"cond_signal: created first lock");
 143         my $tr2 = threads->create(\&bar);
 144         cond_wait($lock);
 145         $tr2->join();
 146         ok(5,1,"cond_signal: joined");
 147     }
 148
 149     sub bar {
 150         ok(2,1,"cond_signal: child before lock");
 151         lock($lock);
 152         ok(3,1,"cond_signal: child locked");
 153         cond_signal($lock);
 154         ok(4,1,"cond_signal: signalled");
 155     }
 156
 157     my $tr  = threads->create(\&foo);
 158     $tr->join();
 159
 160     $Base += 5;
 161
 162     # ditto, but with lockrefs
 163
 164     my $lockref = \$lock;
 165     sub foo2 {
 166         lock($lockref);
 167         ok(1,1,"cond_signal: ref: created first lock");
 168         my $tr2 = threads->create(\&bar2);
 169         cond_wait($lockref);
 170         $tr2->join();
 171         ok(5,1,"cond_signal: ref: joined");
 172     }
 173
 174     sub bar2 {
 175         ok(2,1,"cond_signal: ref: child before lock");
 176         lock($lockref);
 177         ok(3,1,"cond_signal: ref: child locked");
 178         cond_signal($lockref);
 179         ok(4,1,"cond_signal: ref: signalled");
 180     }
 181
 182     $tr  = threads->create(\&foo2);
 183     $tr->join();
 184
 185     $Base += 5;
 186
 187 }
 188
 189
 190 # test cond_broadcast()
 191
 192 {
 193     my $counter : shared = 0;
 194
 195     # broad(N) forks off broad(N-1) and goes into a wait, in such a way
 196     # that it's guaranteed to reach the wait before its child enters the
 197     # locked region. When N reaches 0, the child instead does a
 198     # cond_broadcast to wake all its ancestors.
 199
 200     sub broad {
 201         my $n = shift;
 202         my $th;
 203         {
 204             lock($counter);
 205             if ($n > 0) {
 206                 $counter++;
 207                 $th = threads->new(\&broad, $n-1);
 208                 cond_wait($counter);
 209                 $counter += 10;
 210             }
 211             else {
 212                 ok(1, $counter == 3, "cond_broadcast: all three waiting");
 213                 cond_broadcast($counter);
 214             }
 215         }
 216         $th->join if $th;
 217     }
 218
 219     threads->new(\&broad, 3)->join;
 220     ok(2, $counter == 33, "cond_broadcast: all three threads woken");
 221     print "# counter=$counter\n";
 222
 223     $Base += 2;
 224
 225
 226     # ditto, but with refs and shared()
 227
 228     my $counter2 = 0;
 229     share($counter2);
 230     my $r = \$counter2;
 231
 232     sub broad2 {
 233         my $n = shift;
 234         my $th;
 235         {
 236             lock($r);
 237             if ($n > 0) {
 238                 $$r++;
 239                 $th = threads->new(\&broad2, $n-1);
 240                 cond_wait($r);
 241                 $$r += 10;
 242             }
 243             else {
 244                 ok(1, $$r == 3, "cond_broadcast: ref: all three waiting");
 245                 cond_broadcast($r);
 246             }
 247         }
 248         $th->join if $th;
 249     }
 250
 251     threads->new(\&broad2, 3)->join;;
 252     ok(2, $$r == 33, "cond_broadcast: ref: all three threads woken");
 253     print "# counter=$$r\n";
 254
 255     $Base += 2;
 256
 257 }
 258
 259 # test warnings;
 260
 261 {
 262     my $warncount = 0;
 263     local $SIG{__WARN__} = sub { $warncount++ };
 264
 265     my $lock : shared;
 266
 267     cond_signal($lock);
 268     ok(1, $warncount == 1, 'get warning on cond_signal');
 269     cond_broadcast($lock);
 270     ok(2, $warncount == 2, 'get warning on cond_broadcast');
 271     no warnings 'threads';
 272     cond_signal($lock);
 273     ok(3, $warncount == 2, 'get no warning on cond_signal');
 274     cond_broadcast($lock);
 275     ok(4, $warncount == 2, 'get no warning on cond_broadcast');
 276
 277     $Base += 4;
 278 }
 279
 280
 281