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 sub forko (&$$); # To prevent deadlock from underlying pthread_* bugs (as in
  33                  # stock RH9 glibc/NPTL) or from our own errors, we run tests
  34                  # in separately forked and alarmed processes.
  35
  36 *forko = ($^O =~ /^dos|os2|mswin32|netware$/i)  # Not on DOSish platforms
  37 ? sub (&$$) { my $code = shift; goto &$code; }
  38 : sub (&$$) {
  39   my ($code, $expected, $patience) = @_;
  40   my ($test_num, $pid);
  41   local *CHLD;
  42
  43   my $bump = $expected;
  44
  45   $patience ||= 60;
  46
  47   unless (defined($pid = open(CHLD, "-|"))) {
  48     die "fork: $!\n";
  49   }
  50   if (! $pid) {   # Child -- run the test
  51     $patience ||= 60;
  52     alarm $patience;
  53     &$code;
  54     exit;
  55   }
  56
  57   while (<CHLD>) {
  58     $expected--, $test_num=$1 if /^(?:not )?ok (\d+)/;
  59     #print "#forko: ($expected, $1) $_";
  60     print;
  61   }
  62
  63   close(CHLD);
  64
  65   while ($expected--) {
  66     $test_num++;
  67     print "not ok $test_num - child status $?\n";
  68   }
  69
  70   $Base += $bump;
  71
  72 };
  73
  74 # - TEST basics
  75
  76 ok(1, defined &cond_wait, "cond_wait() present");
  77 ok(2, (prototype(\&cond_wait) eq '\[$@%];\[$@%]'),
  78     q|cond_wait() prototype '\[$@%];\[$@%]'|);
  79 ok(3, defined &cond_timedwait, "cond_timedwait() present");
  80 ok(4, (prototype(\&cond_timedwait) eq '\[$@%]$;\[$@%]'),
  81     q|cond_timedwait() prototype '\[$@%]$;\[$@%]'|);
  82
  83 $Base += 4;
  84
  85 my @wait_how = (
  86    "simple",  # cond var == lock var; implicit lock; e.g.: cond_wait($c)
  87    "repeat",  # cond var == lock var; explicit lock; e.g.: cond_wait($c, $c)
  88    "twain"    # cond var != lock var; explicit lock; e.g.: cond_wait($c, $l)
  89 );
  90
  91 SYNC_SHARED: {
  92   my $test : shared;  # simple|repeat|twain
  93   my $cond : shared;
  94   my $lock : shared;
  95
  96   print "# testing my \$var : shared\n";
  97   ok(1, 1, "Shared synchronization tests preparation");
  98   $Base += 1;
  99
 100   sub signaller {
 101     ok(2,1,"$test: child before lock");
 102     $test =~ /twain/ ? lock($lock) : lock($cond);
 103     ok(3,1,"$test: child obtained lock");
 104     if ($test =~ 'twain') {
 105       no warnings 'threads';   # lock var != cond var, so disable warnings
 106       cond_signal($cond);
 107     } else {
 108       cond_signal($cond);
 109     }
 110     ok(4,1,"$test: child signalled condition");
 111   }
 112
 113   # - TEST cond_wait
 114   forko( sub {
 115     foreach (@wait_how) {
 116       $test = "cond_wait [$_]";
 117       threads->create(\&cw)->join;
 118       $Base += 6;
 119     }
 120   }, 6*@wait_how, 90);
 121
 122   sub cw {
 123     my $thr;
 124
 125     { # -- begin lock scope; which lock to obtain?
 126       $test =~ /twain/ ? lock($lock) : lock($cond);
 127       ok(1,1, "$test: obtained initial lock");
 128
 129       $thr = threads->create(\&signaller);
 130       for ($test) {
 131         cond_wait($cond), last        if    /simple/;
 132         cond_wait($cond, $cond), last if    /repeat/;
 133         cond_wait($cond, $lock), last if    /twain/;
 134         die "$test: unknown test\n";
 135       }
 136       ok(5,1, "$test: condition obtained");
 137     } # -- end lock scope
 138
 139     $thr->join;
 140     ok(6,1, "$test: join completed");
 141   }
 142
 143   # - TEST cond_timedwait success
 144
 145   forko( sub {
 146     foreach (@wait_how) {
 147       $test = "cond_timedwait [$_]";
 148       threads->create(\&ctw, 5)->join;
 149       $Base += 6;
 150     }
 151   }, 6*@wait_how, 90);
 152
 153   sub ctw($) {
 154     my $to = shift;
 155     my $thr;
 156
 157     { # -- begin lock scope;  which lock to obtain?
 158       $test =~ /twain/ ? lock($lock) : lock($cond);
 159       ok(1,1, "$test: obtained initial lock");
 160
 161       $thr = threads->create(\&signaller);
 162       my $ok = 0;
 163       for ($test) {
 164         $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 165         $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 166         $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 167         die "$test: unknown test\n";
 168       }
 169       ok(5,$ok, "$test: condition obtained");
 170     } # -- end lock scope
 171
 172     $thr->join;
 173     ok(6,1, "$test: join completed");
 174   }
 175
 176   # - TEST cond_timedwait timeout
 177
 178   forko( sub {
 179     foreach (@wait_how) {
 180       $test = "cond_timedwait pause, timeout [$_]";
 181       threads->create(\&ctw_fail, 3)->join;
 182       $Base += 2;
 183     }
 184   }, 2*@wait_how, 90);
 185
 186   forko( sub {
 187     foreach (@wait_how) {
 188       $test = "cond_timedwait instant timeout [$_]";
 189       threads->create(\&ctw_fail, -60)->join;
 190       $Base += 2;
 191     }
 192   }, 2*@wait_how, 90);
 193
 194   # cond_timedwait timeout (relative timeout)
 195   sub ctw_fail {
 196     my $to = shift;
 197
 198     $test =~ /twain/ ? lock($lock) : lock($cond);
 199     ok(1,1, "$test: obtained initial lock");
 200     my $ok;
 201     for ($test) {
 202       $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 203       $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 204       $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 205       die "$test: unknown test\n";
 206     }
 207     ok(2,!defined($ok), "$test: timeout");
 208   }
 209
 210 } # -- SYNCH_SHARED block
 211
 212
 213 # same as above, but with references to lock and cond vars
 214
 215 SYNCH_REFS: {
 216   my $test : shared;  # simple|repeat|twain
 217
 218   my $true_cond; share($true_cond);
 219   my $true_lock; share($true_lock);
 220
 221   my $cond = \$true_cond;
 222   my $lock = \$true_lock;
 223
 224   print "# testing reference to shared(\$var)\n";
 225   ok(1, 1, "Synchronization reference tests preparation");
 226   $Base += 1;
 227
 228   sub signaller2 {
 229     ok(2,1,"$test: child before lock");
 230     $test =~ /twain/ ? lock($lock) : lock($cond);
 231     ok(3,1,"$test: child obtained lock");
 232     if ($test =~ 'twain') {
 233       no warnings 'threads';   # lock var != cond var, so disable warnings
 234       cond_signal($cond);
 235     } else {
 236       cond_signal($cond);
 237     }
 238     ok(4,1,"$test: child signalled condition");
 239   }
 240
 241   # - TEST cond_wait
 242   forko( sub {
 243     foreach (@wait_how) {
 244       $test = "cond_wait [$_]";
 245       threads->create(\&cw2)->join;
 246       $Base += 6;
 247     }
 248   }, 6*@wait_how, 90);
 249
 250   sub cw2 {
 251     my $thr;
 252
 253     { # -- begin lock scope; which lock to obtain?
 254       $test =~ /twain/ ? lock($lock) : lock($cond);
 255       ok(1,1, "$test: obtained initial lock");
 256
 257       $thr = threads->create(\&signaller2);
 258       for ($test) {
 259         cond_wait($cond), last        if    /simple/;
 260         cond_wait($cond, $cond), last if    /repeat/;
 261         cond_wait($cond, $lock), last if    /twain/;
 262         die "$test: unknown test\n";
 263       }
 264       ok(5,1, "$test: condition obtained");
 265     } # -- end lock scope
 266
 267     $thr->join;
 268     ok(6,1, "$test: join completed");
 269   }
 270
 271   # - TEST cond_timedwait success
 272
 273   forko( sub {
 274     foreach (@wait_how) {
 275       $test = "cond_timedwait [$_]";
 276       threads->create(\&ctw2, 5)->join;
 277       $Base += 6;
 278     }
 279   }, 6*@wait_how, 90);
 280
 281   sub ctw2($) {
 282     my $to = shift;
 283     my $thr;
 284
 285     { # -- begin lock scope;  which lock to obtain?
 286       $test =~ /twain/ ? lock($lock) : lock($cond);
 287       ok(1,1, "$test: obtained initial lock");
 288
 289       $thr = threads->create(\&signaller2);
 290       my $ok = 0;
 291       for ($test) {
 292         $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 293         $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 294         $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 295         die "$test: unknown test\n";
 296       }
 297       ok(5,$ok, "$test: condition obtained");
 298     } # -- end lock scope
 299
 300     $thr->join;
 301     ok(6,1, "$test: join completed");
 302   }
 303
 304   # - TEST cond_timedwait timeout
 305
 306   forko( sub {
 307     foreach (@wait_how) {
 308       $test = "cond_timedwait pause, timeout [$_]";
 309       threads->create(\&ctw_fail2, 3)->join;
 310       $Base += 2;
 311     }
 312   }, 2*@wait_how, 90);
 313
 314   forko( sub {
 315     foreach (@wait_how) {
 316       $test = "cond_timedwait instant timeout [$_]";
 317       threads->create(\&ctw_fail2, -60)->join;
 318       $Base += 2;
 319     }
 320   }, 2*@wait_how, 90);
 321
 322   sub ctw_fail2 {
 323     my $to = shift;
 324
 325     $test =~ /twain/ ? lock($lock) : lock($cond);
 326     ok(1,1, "$test: obtained initial lock");
 327     my $ok;
 328     for ($test) {
 329       $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
 330       $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
 331       $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
 332       die "$test: unknown test\n";
 333     }
 334     ok(2,!$ok, "$test: timeout");
 335   }
 336
 337 } # -- SYNCH_REFS block
 338