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..90\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   ok(1, 1, "Shared synchronization tests preparation");
  55   $Base += 1;
  56
  57   sub signaller {
  58     ok(2,1,"$test: child before lock");
  59     $test =~ /twain/ ? lock($lock) : lock($cond);
  60     ok(3,1,"$test: child obtained lock");
  61     if ($test =~ 'twain') {
  62       no warnings 'threads';   # lock var != cond var, so disable warnings
  63       cond_signal($cond);
  64     } else {
  65       cond_signal($cond);
  66     }
  67     ok(4,1,"$test: child signalled condition");
  68   }
  69
  70   # - TEST cond_wait
  71   foreach (@wait_how) {
  72     $test = "cond_wait [$_]";
  73     threads->create(\&cw)->join;
  74     $Base += 5;
  75   }
  76
  77   sub cw {
  78     ## which lock to obtain in this scope?
  79     $test =~ /twain/ ? lock($lock) : lock($cond);
  80     ok(1,1, "$test: obtained initial lock");
  81
  82     my $thr = threads->create(\&signaller);
  83     for ($test) {
  84       cond_wait($cond), last        if    /simple/;
  85       cond_wait($cond, $cond), last if    /repeat/;
  86       cond_wait($cond, $lock), last if    /twain/;
  87       die "$test: unknown test\n";
  88     }
  89     $thr->join;
  90     ok(5,1, "$test: condition obtained");
  91   }
  92
  93   # - TEST cond_timedwait success
  94
  95   foreach (@wait_how) {
  96     $test = "cond_timedwait [$_]";
  97     threads->create(\&ctw, 5)->join;
  98     $Base += 5;
  99   }
 100
 101   sub ctw($) {
 102     my $to = shift;
 103
 104     ## which lock to obtain in this scope?
 105     $test =~ /twain/ ? lock($lock) : lock($cond);
 106     ok(1,1, "$test: obtained initial lock");
 107
 108     my $thr = threads->create(\&signaller);
 109     ### N.B.: RACE!  If $timeout is very soon and/or we are unlucky, we
 110     ###       might timeout on the cond_timedwait before the signaller
 111     ###       thread even attempts lock()ing.
 112     ###       Upshot:  $thr->join() never completes, because signaller is
 113     ###       stuck attempting to lock the mutex we regained after waiting.
 114     my $ok = 0;
 115     for ($test) {
 116       $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 117       $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 118       $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 119       die "$test: unknown test\n";
 120     }
 121     print "# back from cond_timedwait; join()ing\n";
 122     $thr->join;
 123     ok(5,$ok, "$test: condition obtained");
 124   }
 125
 126   # - TEST cond_timedwait timeout
 127
 128   foreach (@wait_how) {
 129     $test = "cond_timedwait pause, timeout [$_]";
 130     threads->create(\&ctw_fail, 3)->join;
 131     $Base += 2;
 132   }
 133
 134   foreach (@wait_how) {
 135     $test = "cond_timedwait instant timeout [$_]";
 136     threads->create(\&ctw_fail, -60)->join;
 137     $Base += 2;
 138   }
 139
 140   # cond_timedwait timeout (relative timeout)
 141   sub ctw_fail {
 142     my $to = shift;
 143
 144     $test =~ /twain/ ? lock($lock) : lock($cond);
 145     ok(1,1, "$test: obtained initial lock");
 146     my $ok;
 147     for ($test) {
 148       $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 149       $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 150       $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 151       die "$test: unknown test\n";
 152     }
 153     ok(2,!defined($ok), "$test: timeout");
 154   }
 155
 156 } # -- SYNCH_SHARED block
 157
 158
 159 # same as above, but with references to lock and cond vars
 160
 161 SYNCH_REFS: {
 162   my $test : shared;  # simple|repeat|twain
 163
 164   my $true_cond; share($true_cond);
 165   my $true_lock; share($true_lock);
 166
 167   my $cond = \$true_cond;
 168   my $lock = \$true_lock;
 169
 170   ok(1, 1, "Synchronization reference tests preparation");
 171   $Base += 1;
 172
 173   sub signaller2 {
 174     ok(2,1,"$test: child before lock");
 175     $test =~ /twain/ ? lock($lock) : lock($cond);
 176     ok(3,1,"$test: child obtained lock");
 177     if ($test =~ 'twain') {
 178       no warnings 'threads';   # lock var != cond var, so disable warnings
 179       cond_signal($cond);
 180     } else {
 181       cond_signal($cond);
 182     }
 183     ok(4,1,"$test: child signalled condition");
 184   }
 185
 186   # - TEST cond_wait
 187   foreach (@wait_how) {
 188     $test = "cond_wait [$_]";
 189     threads->create(\&cw2)->join;
 190     $Base += 5;
 191   }
 192
 193   sub cw2 {
 194     ## which lock to obtain in this scope?
 195     $test =~ /twain/ ? lock($lock) : lock($cond);
 196     ok(1,1, "$test: obtained initial lock");
 197
 198     my $thr = threads->create(\&signaller2);
 199     for ($test) {
 200       cond_wait($cond), last        if    /simple/;
 201       cond_wait($cond, $cond), last if    /repeat/;
 202       cond_wait($cond, $lock), last if    /twain/;
 203       die "$test: unknown test\n";
 204     }
 205     $thr->join;
 206     ok(5,1, "$test: condition obtained");
 207   }
 208
 209   # - TEST cond_timedwait success
 210
 211   foreach (@wait_how) {
 212     $test = "cond_timedwait [$_]";
 213     threads->create(\&ctw2, 5)->join;
 214     $Base += 5;
 215   }
 216
 217   sub ctw2($) {
 218     my $to = shift;
 219
 220     ## which lock to obtain in this scope?
 221     $test =~ /twain/ ? lock($lock) : lock($cond);
 222     ok(1,1, "$test: obtained initial lock");
 223
 224     my $thr = threads->create(\&signaller2);
 225     ###  N.B.:  RACE!  as above, with ctw()
 226     my $ok = 0;
 227     for ($test) {
 228       $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 229       $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 230       $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 231       die "$test: unknown test\n";
 232     }
 233     $thr->join;
 234     ok(5,$ok, "$test: condition obtained");
 235   }
 236
 237   # - TEST cond_timedwait timeout
 238
 239   foreach (@wait_how) {
 240     $test = "cond_timedwait pause, timeout [$_]";
 241     threads->create(\&ctw_fail2, 3)->join;
 242     $Base += 2;
 243   }
 244
 245   foreach (@wait_how) {
 246     $test = "cond_timedwait instant timeout [$_]";
 247     threads->create(\&ctw_fail2, -60)->join;
 248     $Base += 2;
 249   }
 250
 251   sub ctw_fail2 {
 252     my $to = shift;
 253
 254     $test =~ /twain/ ? lock($lock) : lock($cond);
 255     ok(1,1, "$test: obtained initial lock");
 256     my $ok;
 257     for ($test) {
 258       $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 259       $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 260       $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 261       die "$test: unknown test\n";
 262     }
 263     ok(2,!$ok, "$test: timeout");
 264   }
 265
 266 } # -- SYNCH_REFS block
 267