ext/threads/shared/t/wait.t

   1 # cond_wait and cond_timedwait extended tests
   2 # adapted from cond.t
   3
   4 use warnings;
   5
   6 BEGIN {
   7     chdir 't' if -d 't';
   8     push @INC ,'../lib';
   9     require Config; import Config;
  10     unless ($Config{'useithreads'}) {
  11         print "1..0 # Skip: no threads\n";
  12         exit 0;
  13     }
  14 }
  15 $|++;
  16 print "1..102\n";
  17 use strict;
  18
  19 use threads;
  20 use threads::shared;
  21 use ExtUtils::testlib;
  22
  23 my $Base = 0;
  24
  25 sub ok {
  26     my ($offset, $bool, $text) = @_;
  27     my $not = '';
  28     $not = "not " unless $bool;
  29     print "${not}ok " . ($Base + $offset) . " - $text\n";
  30 }
  31
  32 # - TEST basics
  33
  34 ok(1, defined &cond_wait, "cond_wait() present");
  35 ok(2, (prototype(\&cond_wait) eq '\[$@%];\[$@%]'),
  36     q|cond_wait() prototype '\[$@%];\[$@%]'|);
  37 ok(3, defined &cond_timedwait, "cond_timedwait() present");
  38 ok(4, (prototype(\&cond_timedwait) eq '\[$@%]$;\[$@%]'),
  39     q|cond_timedwait() prototype '\[$@%]$;\[$@%]'|);
  40
  41 $Base += 4;
  42
  43 my @wait_how = (
  44    "simple",  # cond var == lock var; implicit lock; e.g.: cond_wait($c)
  45    "repeat",  # cond var == lock var; explicit lock; e.g.: cond_wait($c, $c)
  46    "twain"    # cond var != lock var; explicit lock; e.g.: cond_wait($c, $l)
  47 );
  48
  49 SYNC_SHARED: {
  50   my $test : shared;  # simple|repeat|twain
  51   my $cond : shared;
  52   my $lock : shared;
  53
  54   print "# testing my \$var : shared\n";
  55   ok(1, 1, "Shared synchronization tests preparation");
  56   $Base += 1;
  57
  58   sub signaller {
  59     ok(2,1,"$test: child before lock");
  60     $test =~ /twain/ ? lock($lock) : lock($cond);
  61     ok(3,1,"$test: child obtained lock");
  62     if ($test =~ 'twain') {
  63       no warnings 'threads';   # lock var != cond var, so disable warnings
  64       cond_signal($cond);
  65     } else {
  66       cond_signal($cond);
  67     }
  68     ok(4,1,"$test: child signalled condition");
  69   }
  70
  71   # - TEST cond_wait
  72   foreach (@wait_how) {
  73     $test = "cond_wait [$_]";
  74     threads->create(\&cw)->join;
  75     $Base += 6;
  76   }
  77
  78   sub cw {
  79     my $thr;
  80
  81     { # -- begin lock scope; which lock to obtain?
  82       $test =~ /twain/ ? lock($lock) : lock($cond);
  83       ok(1,1, "$test: obtained initial lock");
  84
  85       $thr = threads->create(\&signaller);
  86       for ($test) {
  87         cond_wait($cond), last        if    /simple/;
  88         cond_wait($cond, $cond), last if    /repeat/;
  89         cond_wait($cond, $lock), last if    /twain/;
  90         die "$test: unknown test\n";
  91       }
  92       ok(5,1, "$test: condition obtained");
  93     } # -- end lock scope
  94
  95     $thr->join;
  96     ok(6,1, "$test: join completed");
  97   }
  98
  99   # - TEST cond_timedwait success
 100
 101   foreach (@wait_how) {
 102     $test = "cond_timedwait [$_]";
 103     threads->create(\&ctw, 5)->join;
 104     $Base += 6;
 105   }
 106
 107   sub ctw($) {
 108     my $to = shift;
 109     my $thr;
 110
 111     { # -- begin lock scope;  which lock to obtain?
 112       $test =~ /twain/ ? lock($lock) : lock($cond);
 113       ok(1,1, "$test: obtained initial lock");
 114
 115       $thr = threads->create(\&signaller);
 116       my $ok = 0;
 117       for ($test) {
 118         $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 119         $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 120         $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 121         die "$test: unknown test\n";
 122       }
 123       ok(5,$ok, "$test: condition obtained");
 124     } # -- end lock scope
 125
 126     $thr->join;
 127     ok(6,1, "$test: join completed");
 128   }
 129
 130   # - TEST cond_timedwait timeout
 131
 132   foreach (@wait_how) {
 133     $test = "cond_timedwait pause, timeout [$_]";
 134     threads->create(\&ctw_fail, 3)->join;
 135     $Base += 2;
 136   }
 137
 138   foreach (@wait_how) {
 139     $test = "cond_timedwait instant timeout [$_]";
 140     threads->create(\&ctw_fail, -60)->join;
 141     $Base += 2;
 142   }
 143
 144   # cond_timedwait timeout (relative timeout)
 145   sub ctw_fail {
 146     my $to = shift;
 147
 148     $test =~ /twain/ ? lock($lock) : lock($cond);
 149     ok(1,1, "$test: obtained initial lock");
 150     my $ok;
 151     for ($test) {
 152       $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 153       $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 154       $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 155       die "$test: unknown test\n";
 156     }
 157     ok(2,!defined($ok), "$test: timeout");
 158   }
 159
 160 } # -- SYNCH_SHARED block
 161
 162
 163 # same as above, but with references to lock and cond vars
 164
 165 SYNCH_REFS: {
 166   my $test : shared;  # simple|repeat|twain
 167
 168   my $true_cond; share($true_cond);
 169   my $true_lock; share($true_lock);
 170
 171   my $cond = \$true_cond;
 172   my $lock = \$true_lock;
 173
 174   print "# testing reference to shared(\$var)\n";
 175   ok(1, 1, "Synchronization reference tests preparation");
 176   $Base += 1;
 177
 178   sub signaller2 {
 179     ok(2,1,"$test: child before lock");
 180     $test =~ /twain/ ? lock($lock) : lock($cond);
 181     ok(3,1,"$test: child obtained lock");
 182     if ($test =~ 'twain') {
 183       no warnings 'threads';   # lock var != cond var, so disable warnings
 184       cond_signal($cond);
 185     } else {
 186       cond_signal($cond);
 187     }
 188     ok(4,1,"$test: child signalled condition");
 189   }
 190
 191   # - TEST cond_wait
 192   foreach (@wait_how) {
 193     $test = "cond_wait [$_]";
 194     threads->create(\&cw2)->join;
 195     $Base += 6;
 196   }
 197
 198   sub cw2 {
 199     my $thr;
 200
 201     { # -- begin lock scope; which lock to obtain?
 202       $test =~ /twain/ ? lock($lock) : lock($cond);
 203       ok(1,1, "$test: obtained initial lock");
 204
 205       $thr = threads->create(\&signaller2);
 206       for ($test) {
 207         cond_wait($cond), last        if    /simple/;
 208         cond_wait($cond, $cond), last if    /repeat/;
 209         cond_wait($cond, $lock), last if    /twain/;
 210         die "$test: unknown test\n";
 211       }
 212       ok(5,1, "$test: condition obtained");
 213     } # -- end lock scope
 214
 215     $thr->join;
 216     ok(6,1, "$test: join completed");
 217   }
 218
 219   # - TEST cond_timedwait success
 220
 221   foreach (@wait_how) {
 222     $test = "cond_timedwait [$_]";
 223     threads->create(\&ctw2, 5)->join;
 224     $Base += 6;
 225   }
 226
 227   sub ctw2($) {
 228     my $to = shift;
 229     my $thr;
 230
 231     { # -- begin lock scope;  which lock to obtain?
 232       $test =~ /twain/ ? lock($lock) : lock($cond);
 233       ok(1,1, "$test: obtained initial lock");
 234
 235       $thr = threads->create(\&signaller2);
 236       my $ok = 0;
 237       for ($test) {
 238         $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 239         $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 240         $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 241         die "$test: unknown test\n";
 242       }
 243       ok(5,$ok, "$test: condition obtained");
 244     } # -- end lock scope
 245
 246     $thr->join;
 247     ok(6,1, "$test: join completed");
 248   }
 249
 250   # - TEST cond_timedwait timeout
 251
 252   foreach (@wait_how) {
 253     $test = "cond_timedwait pause, timeout [$_]";
 254     threads->create(\&ctw_fail2, 3)->join;
 255     $Base += 2;
 256   }
 257
 258   foreach (@wait_how) {
 259     $test = "cond_timedwait instant timeout [$_]";
 260     threads->create(\&ctw_fail2, -60)->join;
 261     $Base += 2;
 262   }
 263
 264   sub ctw_fail2 {
 265     my $to = shift;
 266
 267     $test =~ /twain/ ? lock($lock) : lock($cond);
 268     ok(1,1, "$test: obtained initial lock");
 269     my $ok;
 270     for ($test) {
 271       $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 272       $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 273       $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 274       die "$test: unknown test\n";
 275     }
 276     ok(2,!$ok, "$test: timeout");
 277   }
 278
 279 } # -- SYNCH_REFS block
 280