view release on metacpan or  search on metacpan

omnithreads/shared/t/wait.t  view on Meta::CPAN

? sub (&$$) { my $code = shift; goto &$code; }
: sub (&$$) {
  my ($code, $expected, $patience) = @_;
  my ($test_num, $pid);
  local *CHLD;

  my $bump = $expected;

  $patience ||= 60;

  unless (defined($pid = open(CHLD, "-|"))) {
    die "fork: $!\n";
  }
  if (! $pid) {   # Child -- run the test
    $patience ||= 60;
    alarm $patience;
    &$code;
    exit;
  }

  while (<CHLD>) {
    $expected--, $test_num=$1 if /^(?:not )?ok (\d+)/;
    #print "#forko: ($expected, $1) $_";
    print;
  }

  close(CHLD);

  while ($expected--) {
    $test_num++;
    print "not ok $test_num - child status $?\n";
  }

  $Base += $bump;

};

# - TEST basics

ok(1, defined &cond_wait, "cond_wait() present");
ok(2, (prototype(\&cond_wait) eq '\[$@%];\[$@%]'),
    q|cond_wait() prototype '\[$@%];\[$@%]'|);
ok(3, defined &cond_timedwait, "cond_timedwait() present");
ok(4, (prototype(\&cond_timedwait) eq '\[$@%]$;\[$@%]'),
    q|cond_timedwait() prototype '\[$@%]$;\[$@%]'|);

$Base += 4;

my @wait_how = (
   "simple",  # cond var == lock var; implicit lock; e.g.: cond_wait($c)
   "repeat",  # cond var == lock var; explicit lock; e.g.: cond_wait($c, $c)
   "twain"    # cond var != lock var; explicit lock; e.g.: cond_wait($c, $l)
);

SYNC_SHARED: {
  my $test : shared;  # simple|repeat|twain
  my $cond : shared;
  my $lock : shared;

  print "# testing my \$var : shared\n";
  ok(1, 1, "Shared synchronization tests preparation");
  $Base += 1;

  sub signaller {
    ok(2,1,"$test: child before lock");
    $test =~ /twain/ ? lock($lock) : lock($cond);
    ok(3,1,"$test: child obtained lock");
    if ($test =~ 'twain') {
      no warnings 'threads';   # lock var != cond var, so disable warnings
      cond_signal($cond);
    } else {
      cond_signal($cond);
    }
    ok(4,1,"$test: child signalled condition");
  }

  # - TEST cond_wait
  forko( sub {
    foreach (@wait_how) {
      $test = "cond_wait [$_]";
      omnithreads->create(\&cw)->join;
      $Base += 6;
    }
  }, 6*@wait_how, 90);

  sub cw {
    my $thr;

    { # -- begin lock scope; which lock to obtain?
      $test =~ /twain/ ? lock($lock) : lock($cond);
      ok(1,1, "$test: obtained initial lock");

      $thr = omnithreads->create(\&signaller);
      for ($test) {
        cond_wait($cond), last        if    /simple/;
        cond_wait($cond, $cond), last if    /repeat/;
        cond_wait($cond, $lock), last if    /twain/;
        die "$test: unknown test\n"; 
      }
      ok(5,1, "$test: condition obtained");
    } # -- end lock scope

    $thr->join;
    ok(6,1, "$test: join completed");
  }

  # - TEST cond_timedwait success

  forko( sub {
    foreach (@wait_how) {
      $test = "cond_timedwait [$_]";
      omnithreads->create(\&ctw, 5)->join;
      $Base += 6;
    }
  }, 6*@wait_how, 90);

  sub ctw($) {
    my $to = shift;
    my $thr;

    { # -- begin lock scope;  which lock to obtain?