threads::shared 1.23

From: "Jerry D. Hedden" <jdhedden@cpan.org>
Message-ID: <1ff86f510806171328y54650760u12c8148830a60a63@mail.gmail.com>

p4raw-id: //depot/perl@34074

3 files changed, 461 insertions, 465 deletions

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index 37c07042f1..c73303b71d 100644
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -7,7 +7,7 @@ use warnings;
 
 use Scalar::Util qw(reftype refaddr blessed);
 
-our $VERSION = '1.22';
+our $VERSION = '1.23';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -186,7 +186,7 @@ threads::shared - Perl extension for sharing data structures between threads
 
 =head1 VERSION
 
-This document describes threads::shared version 1.22
+This document describes threads::shared version 1.23
 
 =head1 SYNOPSIS
 
@@ -540,7 +540,7 @@ L<threads::shared> Discussion Forum on CPAN:
 L<http://www.cpanforum.com/dist/threads-shared>
 
 Annotated POD for L<threads::shared>:
-L<http://annocpan.org/~JDHEDDEN/threads-shared-1.22/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.23/shared.pm>
 
 Source repository:
 L<http://code.google.com/p/threads-shared/>
diff --git a/ext/threads/shared/t/wait.t b/ext/threads/shared/t/wait.t
index 6863292fe2..c08e2ed788 100644
--- a/ext/threads/shared/t/wait.t
+++ b/ext/threads/shared/t/wait.t
@@ -1,12 +1,12 @@
 use strict;
 use warnings;
 
+use Config;
 BEGIN {
     if ($ENV{'PERL_CORE'}){
         chdir 't';
         unshift @INC, '../lib';
     }
-    use Config;
     if (! $Config{'useithreads'}) {
         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
         exit(0);
@@ -15,10 +15,30 @@ BEGIN {
 
 use ExtUtils::testlib;
 
-my $Base = 0;
+### Self-destruct timer child process
+my $TIMEOUT = 600;
+my $timer_pid;
+
+if ($Config{'d_fork'}) {
+    $timer_pid = fork();
+    if (defined($timer_pid) && ($timer_pid == 0)) {
+        # Child process
+        my $ppid = getppid();
+
+        # Sleep for timeout period
+        sleep($TIMEOUT - 2);   # Workaround for perlbug #49073
+        sleep(2);              # Wait for parent to exit
+
+        # Kill parent if it still exists
+        kill('KILL', $ppid) if (kill(0, $ppid));
+        exit(0);
+    }
+    # Parent will kill this process if tests finish on time
+}
+
+
 sub ok {
     my ($id, $ok, $name) = @_;
-    $id += $Base;
 
     # You have to do it this way or VMS will get confused.
     if ($ok) {
@@ -38,8 +58,10 @@ BEGIN {
 
 use threads;
 use threads::shared;
-ok(1, 1, 'Loaded');
-$Base++;
+
+my $TEST = 1;
+ok($TEST++, 1, 'Loaded');
+
 
 ### Start of Testing ###
 
@@ -56,174 +78,147 @@ $Base++;
 # and consider upgrading their glibc.
 
 
-sub forko (&$$); # To prevent deadlock from underlying pthread_* bugs (as in
-                 # stock RH9 glibc/NPTL) or from our own errors, we run tests
-                 # in separately forked and alarmed processes.
+# - TEST basics
 
-*forko = ($^O =~ /^dos|os2|mswin32|netware|vms$/i)
-? sub (&$$) { my $code = shift; goto &$code; }
-: sub (&$$) {
-  my ($code, $expected, $patience) = @_;
-  my ($test_num, $pid);
-  local *CHLD;
+ok($TEST++, defined &cond_wait, "cond_wait() present");
+ok($TEST++, (prototype(\&cond_wait) eq '\[$@%];\[$@%]'),
+                q/cond_wait() prototype '\[$@%];\[$@%]'/);
+ok($TEST++, defined &cond_timedwait, "cond_timedwait() present");
+ok($TEST++, (prototype(\&cond_timedwait) eq '\[$@%]$;\[$@%]'),
+                q/cond_timedwait() prototype '\[$@%]$;\[$@%]'/);
 
-  my $bump = $expected;
 
-  unless (defined($pid = open(CHLD, "-|"))) {
-    die "fork: $!\n";
-  }
-  if (! $pid) {   # Child -- run the test
-    alarm($patience || 60);
-    &$code;
-    exit;
-  }
+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)
+);
 
-  while (<CHLD>) {
-    $expected--, $test_num=$1 if /^(?:not )?ok (\d+)/;
-    #print "#forko: ($expected, $1) $_";
-    print;
-  }
 
-  close(CHLD);
+SYNC_SHARED: {
+    my $test_type :shared;   # simple|repeat|twain
 
-  while ($expected--) {
-    ok(++$test_num, 0, "missing test result: child status $?");
-  }
+    my $cond :shared;
+    my $lock :shared;
 
-  $Base += $bump;
-};
+    ok($TEST++, 1, "Shared synchronization tests preparation");
 
+    sub signaller
+    {
+        my $testno = $_[0];
 
-# - TEST basics
+        ok($testno++, 1, "$test_type: child before lock");
+        $test_type =~ /twain/ ? lock($lock) : lock($cond);
+        ok($testno++, 1, "$test_type: child obtained lock");
 
-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 '\[$@%]$;\[$@%]'|);
+        if ($test_type =~ 'twain') {
+            no warnings 'threads';   # lock var != cond var, so disable warnings
+            cond_signal($cond);
+        } else {
+            cond_signal($cond);
+        }
+        ok($testno++, 1, "$test_type: child signalled condition");
 
-$Base += 4;
+        return($testno);
+    }
 
-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)
-);
+    # - TEST cond_wait
 
-SYNC_SHARED: {
-  my $test : shared;  # simple|repeat|twain
-  my $cond : shared;
-  my $lock : shared;
-
-  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);
+    sub cw
+    {
+        my ($testnum, $to) = @_;
+
+        # Which lock to obtain?
+        $test_type =~ /twain/ ? lock($lock) : lock($cond);
+        ok($testnum++, 1, "$test_type: obtained initial lock");
+
+        my $thr = threads->create(\&signaller, $testnum);
+        for ($test_type) {
+            cond_wait($cond), last        if /simple/;
+            cond_wait($cond, $cond), last if /repeat/;
+            cond_wait($cond, $lock), last if /twain/;
+            die "$test_type: unknown test\n";
+        }
+        $testnum = $thr->join();
+        ok($testnum++, 1, "$test_type: condition obtained");
+
+        return ($testnum);
     }
-    ok(4,1,"$test: child signalled condition");
-  }
 
-  # - TEST cond_wait
-  forko( sub {
     foreach (@wait_how) {
-      $test = "cond_wait [$_]";
-      threads->create(\&cw)->join;
-      $Base += 5;
+        $test_type = "cond_wait [$_]";
+        my $thr = threads->create(\&cw, $TEST);
+        $TEST = $thr->join();
     }
-  }, 5*@wait_how, 90);
-
-  sub cw {
-      # which lock to obtain?
-      $test =~ /twain/ ? lock($lock) : lock($cond);
-      ok(1,1, "$test: obtained initial lock");
-
-      my $thr = threads->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";
-      }
-      $thr->join;
-      ok(5,1, "$test: condition obtained");
-  }
-
-  # - TEST cond_timedwait success
-
-  forko( sub {
-    foreach (@wait_how) {
-      $test = "cond_timedwait [$_]";
-      threads->create(\&ctw, 5)->join;
-      $Base += 5;
+
+    # - TEST cond_timedwait success
+
+    sub ctw_ok
+    {
+        my ($testnum, $to) = @_;
+
+        # Which lock to obtain?
+        $test_type =~ /twain/ ? lock($lock) : lock($cond);
+        ok($testnum++, 1, "$test_type: obtained initial lock");
+
+        my $thr = threads->create(\&signaller, $testnum);
+        my $ok = 0;
+        for ($test_type) {
+            $ok = cond_timedwait($cond, time() + $to), last        if /simple/;
+            $ok = cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
+            $ok = cond_timedwait($cond, time() + $to, $lock), last if /twain/;
+            die "$test_type: unknown test\n";
+        }
+        $testnum = $thr->join();
+        ok($testnum++, $ok, "$test_type: condition obtained");
+
+        return ($testnum);
     }
-  }, 5*@wait_how, 90);
-
-  sub ctw($) {
-      my $to = shift;
-
-      # which lock to obtain?
-      $test =~ /twain/ ? lock($lock) : lock($cond);
-      ok(1,1, "$test: obtained initial lock");
-
-      my $thr = threads->create(\&signaller);
-      my $ok = 0;
-      for ($test) {
-        $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
-        $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
-        $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
-        die "$test: unknown test\n";
-      }
-      $thr->join;
-      ok(5,$ok, "$test: condition obtained");
-  }
-
-  # - TEST cond_timedwait timeout
-
-  forko( sub {
+
     foreach (@wait_how) {
-      $test = "cond_timedwait pause, timeout [$_]";
-      threads->create(\&ctw_fail, 3)->join;
-      $Base += 2;
+        $test_type = "cond_timedwait [$_]";
+        my $thr = threads->create(\&ctw_ok, $TEST, 5);
+        $TEST = $thr->join();
+    }
+
+    # - TEST cond_timedwait timeout
+
+    sub ctw_fail
+    {
+        my ($testnum, $to) = @_;
+
+        if ($^O eq "hpux" && $Config{osvers} <= 10.20) {
+            # The lock obtaining would pass, but the wait will not.
+            ok($testnum++, 1, "$test_type: obtained initial lock");
+            ok($testnum++, 0, "# SKIP see perl583delta");
+
+        } else {
+            $test_type =~ /twain/ ? lock($lock) : lock($cond);
+            ok($testnum++, 1, "$test_type: obtained initial lock");
+            my $ok;
+            for ($test_type) {
+                $ok = cond_timedwait($cond, time() + $to), last        if /simple/;
+                $ok = cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
+                $ok = cond_timedwait($cond, time() + $to, $lock), last if /twain/;
+                die "$test_type: unknown test\n";
+            }
+            ok($testnum++, ! defined($ok), "$test_type: timeout");
+        }
+
+        return ($testnum);
     }
-  }, 2*@wait_how, 90);
 
-  forko( sub {
     foreach (@wait_how) {
-      $test = "cond_timedwait instant timeout [$_]";
-      threads->create(\&ctw_fail, -60)->join;
-      $Base += 2;
+        $test_type = "cond_timedwait pause, timeout [$_]";
+        my $thr = threads->create(\&ctw_fail, $TEST, 3);
+        $TEST = $thr->join();
     }
-  }, 2*@wait_how, 90);
-
-  # cond_timedwait timeout (relative timeout)
-  sub ctw_fail {
-    my $to = shift;
-    if ($^O eq "hpux" && $Config{osvers} <= 10.20) {
-      # The lock obtaining would pass, but the wait will not.
-      ok(1,1, "$test: obtained initial lock");
-      ok(2,0, "# SKIP see perl583delta");
-    } else {
-      $test =~ /twain/ ? lock($lock) : lock($cond);
-      ok(1,1, "$test: obtained initial lock");
-      my $ok;
-      for ($test) {
-        $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
-        $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
-        $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
-        die "$test: unknown test\n";
-      }
-      ok(2,!defined($ok), "$test: timeout");
+
+    foreach (@wait_how) {
+        $test_type = "cond_timedwait instant timeout [$_]";
+        my $thr = threads->create(\&ctw_fail, $TEST, -60);
+        $TEST = $thr->join();
     }
-  }
 
 } # -- SYNCH_SHARED block
 
@@ -231,125 +226,141 @@ SYNC_SHARED: {
 # same as above, but with references to lock and cond vars
 
 SYNCH_REFS: {
-  my $test : shared;  # simple|repeat|twain
+    my $test_type :shared;   # simple|repeat|twain
 
-  my $true_cond; share($true_cond);
-  my $true_lock; share($true_lock);
+    my $true_cond :shared;
+    my $true_lock :shared;
 
-  my $cond = \$true_cond;
-  my $lock = \$true_lock;
+    my $cond = \$true_cond;
+    my $lock = \$true_lock;
 
-  ok(1, 1, "Synchronization reference tests preparation");
-  $Base += 1;
+    ok($TEST++, 1, "Synchronization reference tests preparation");
 
-  sub signaller2 {
-    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);
+    sub signaller2
+    {
+        my $testno = $_[0];
+
+        ok($testno++, 1, "$test_type: child before lock");
+        $test_type =~ /twain/ ? lock($lock) : lock($cond);
+        ok($testno++, 1, "$test_type: child obtained lock");
+
+        if ($test_type =~ 'twain') {
+            no warnings 'threads';   # lock var != cond var, so disable warnings
+            cond_signal($cond);
+        } else {
+            cond_signal($cond);
+        }
+        ok($testno++, 1, "$test_type: child signalled condition");
+
+        return($testno);
     }
-    ok(4,1,"$test: child signalled condition");
-  }
 
-  # - TEST cond_wait
-  forko( sub {
-    foreach (@wait_how) {
-      $test = "cond_wait [$_]";
-      threads->create(\&cw2)->join;
-      $Base += 5;
+    # - TEST cond_wait
+
+    sub cw2
+    {
+        my ($testnum, $to) = @_;
+
+        # Which lock to obtain?
+        $test_type =~ /twain/ ? lock($lock) : lock($cond);
+        ok($testnum++, 1, "$test_type: obtained initial lock");
+
+        my $thr = threads->create(\&signaller2, $testnum);
+        for ($test_type) {
+            cond_wait($cond), last        if /simple/;
+            cond_wait($cond, $cond), last if /repeat/;
+            cond_wait($cond, $lock), last if /twain/;
+            die "$test_type: unknown test\n";
+        }
+        $testnum = $thr->join();
+        ok($testnum++, 1, "$test_type: condition obtained");
+
+        return ($testnum);
     }
-  }, 5*@wait_how, 90);
-
-  sub cw2 {
-      # which lock to obtain?
-      $test =~ /twain/ ? lock($lock) : lock($cond);
-      ok(1,1, "$test: obtained initial lock");
-
-      my $thr = threads->create(\&signaller2);
-      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";
-      }
-      $thr->join;
-      ok(5,1, "$test: condition obtained");
-  }
-
-  # - TEST cond_timedwait success
-
-  forko( sub {
+
     foreach (@wait_how) {
-      $test = "cond_timedwait [$_]";
-      threads->create(\&ctw2, 5)->join;
-      $Base += 5;
+        $test_type = "cond_wait [$_]";
+        my $thr = threads->create(\&cw2, $TEST);
+        $TEST = $thr->join();
     }
-  }, 5*@wait_how, 90);
-
-  sub ctw2($) {
-      my $to = shift;
-
-      # which lock to obtain?
-      $test =~ /twain/ ? lock($lock) : lock($cond);
-      ok(1,1, "$test: obtained initial lock");
-
-      my $thr = threads->create(\&signaller2);
-      my $ok = 0;
-      for ($test) {
-        $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
-        $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
-        $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
-        die "$test: unknown test\n";
-      }
-      $thr->join;
-      ok(5,$ok, "$test: condition obtained");
-  }
-
-  # - TEST cond_timedwait timeout
-
-  forko( sub {
-    foreach (@wait_how) {
-      $test = "cond_timedwait pause, timeout [$_]";
-      threads->create(\&ctw_fail2, 3)->join;
-      $Base += 2;
+
+    # - TEST cond_timedwait success
+
+    sub ctw_ok2
+    {
+        my ($testnum, $to) = @_;
+
+        # Which lock to obtain?
+        $test_type =~ /twain/ ? lock($lock) : lock($cond);
+        ok($testnum++, 1, "$test_type: obtained initial lock");
+
+        my $thr = threads->create(\&signaller2, $testnum);
+        my $ok = 0;
+        for ($test_type) {
+            $ok = cond_timedwait($cond, time() + $to), last        if /simple/;
+            $ok = cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
+            $ok = cond_timedwait($cond, time() + $to, $lock), last if /twain/;
+            die "$test_type: unknown test\n";
+        }
+        $testnum = $thr->join();
+        ok($testnum++, $ok, "$test_type: condition obtained");
+
+        return ($testnum);
     }
-  }, 2*@wait_how, 90);
 
-  forko( sub {
     foreach (@wait_how) {
-      $test = "cond_timedwait instant timeout [$_]";
-      threads->create(\&ctw_fail2, -60)->join;
-      $Base += 2;
+        $test_type = "cond_timedwait [$_]";
+        my $thr = threads->create(\&ctw_ok2, $TEST, 5);
+        $TEST = $thr->join();
     }
-  }, 2*@wait_how, 90);
 
-  sub ctw_fail2 {
-    my $to = shift;
+    # - TEST cond_timedwait timeout
+
+    sub ctw_fail2
+    {
+        my ($testnum, $to) = @_;
+
+        if ($^O eq "hpux" && $Config{osvers} <= 10.20) {
+            # The lock obtaining would pass, but the wait will not.
+            ok($testnum++, 1, "$test_type: obtained initial lock");
+            ok($testnum++, 0, "# SKIP see perl583delta");
+
+        } else {
+            $test_type =~ /twain/ ? lock($lock) : lock($cond);
+            ok($testnum++, 1, "$test_type: obtained initial lock");
+            my $ok;
+            for ($test_type) {
+                $ok = cond_timedwait($cond, time() + $to), last        if /simple/;
+                $ok = cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
+                $ok = cond_timedwait($cond, time() + $to, $lock), last if /twain/;
+                die "$test_type: unknown test\n";
+            }
+            ok($testnum++, ! defined($ok), "$test_type: timeout");
+        }
+
+        return ($testnum);
+    }
 
-    if ($^O eq "hpux" && $Config{osvers} <= 10.20) {
-      # The lock obtaining would pass, but the wait will not.
-      ok(1,1, "$test: obtained initial lock");
-      ok(2,0, "# SKIP see perl583delta");
-    } else {
-      $test =~ /twain/ ? lock($lock) : lock($cond);
-      ok(1,1, "$test: obtained initial lock");
-      my $ok;
-      for ($test) {
-        $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
-        $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
-        $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
-        die "$test: unknown test\n";
-      }
-      ok(2,!$ok, "$test: timeout");
+    foreach (@wait_how) {
+        $test_type = "cond_timedwait pause, timeout [$_]";
+        my $thr = threads->create(\&ctw_fail2, $TEST, 3);
+        $TEST = $thr->join();
+    }
+
+    foreach (@wait_how) {
+        $test_type = "cond_timedwait instant timeout [$_]";
+        my $thr = threads->create(\&ctw_fail2, $TEST, -60);
+        $TEST = $thr->join();
     }
-  }
 
 } # -- SYNCH_REFS block
 
+# Kill timer process
+if ($timer_pid && kill(0, $timer_pid)) {
+    kill('KILL', $timer_pid);
+}
+
+# Done
 exit(0);
 
 # EOF
diff --git a/ext/threads/shared/t/waithires.t b/ext/threads/shared/t/waithires.t
index b2e9146ca0..2817334144 100644
--- a/ext/threads/shared/t/waithires.t
+++ b/ext/threads/shared/t/waithires.t
@@ -1,12 +1,12 @@
 use strict;
 use warnings;
 
+use Config;
 BEGIN {
     if ($ENV{'PERL_CORE'}){
         chdir 't';
         unshift @INC, '../lib';
     }
-    use Config;
     if (! $Config{'useithreads'}) {
         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
         exit(0);
@@ -23,10 +23,30 @@ BEGIN {
 
 use ExtUtils::testlib;
 
-my $Base = 0;
+### Self-destruct timer child process
+my $TIMEOUT = 60;
+my $timer_pid;
+
+if ($Config{'d_fork'}) {
+    $timer_pid = fork();
+    if (defined($timer_pid) && ($timer_pid == 0)) {
+        # Child process
+        my $ppid = getppid();
+
+        # Sleep for timeout period
+        sleep($TIMEOUT - 2);   # Workaround for perlbug #49073
+        sleep(2);              # Wait for parent to exit
+
+        # Kill parent if it still exists
+        kill('KILL', $ppid) if (kill(0, $ppid));
+        exit(0);
+    }
+    # Parent will kill this process if tests finish on time
+}
+
+
 sub ok {
     my ($id, $ok, $name) = @_;
-    $id += $Base;
 
     # You have to do it this way or VMS will get confused.
     if ($ok) {
@@ -47,8 +67,9 @@ BEGIN {
 use threads;
 use threads::shared;
 
-ok(1, 1, 'Loaded');
-$Base++;
+my $TEST = 1;
+ok($TEST++, 1, 'Loaded');
+
 
 ### Start of Testing ###
 
@@ -65,149 +86,110 @@ $Base++;
 # and consider upgrading their glibc.
 
 
-sub forko (&$$); # To prevent deadlock from underlying pthread_* bugs (as in
-                 # stock RH9 glibc/NPTL) or from our own errors, we run tests
-                 # in separately forked and alarmed processes.
-
-*forko = ($^O =~ /^dos|os2|mswin32|netware|vms$/i)
-? sub (&$$) { my $code = shift; goto &$code; }
-: sub (&$$) {
-  my ($code, $expected, $patience) = @_;
-  my ($test_num, $pid);
-  local *CHLD;
+# - TEST basics
 
-  my $bump = $expected;
+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)
+);
 
-  unless (defined($pid = open(CHLD, "-|"))) {
-    die "fork: $!\n";
-  }
-  if (! $pid) {   # Child -- run the test
-    alarm($patience || 60);
-    &$code;
-    exit;
-  }
 
-  while (<CHLD>) {
-    $expected--, $test_num=$1 if /^(?:not )?ok (\d+)/;
-    #print "#forko: ($expected, $1) $_";
-    print;
-  }
+SYNC_SHARED: {
+    my $test_type :shared;   # simple|repeat|twain
 
-  close(CHLD);
+    my $cond :shared;
+    my $lock :shared;
 
-  while ($expected--) {
-    ok(++$test_num, 0, "missing test result: child status $?");
-  }
+    ok($TEST++, 1, "Shared synchronization tests preparation");
 
-  $Base += $bump;
-};
+    # - TEST cond_timedwait success
 
+    sub signaller
+    {
+        my $testno = $_[0];
 
-# - TEST basics
+        ok($testno++, 1, "$test_type: child before lock");
+        $test_type =~ /twain/ ? lock($lock) : lock($cond);
+        ok($testno++, 1, "$test_type: child obtained lock");
 
-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)
-);
+        if ($test_type =~ 'twain') {
+            no warnings 'threads';   # lock var != cond var, so disable warnings
+            cond_signal($cond);
+        } else {
+            cond_signal($cond);
+        }
+        ok($testno++, 1, "$test_type: child signalled condition");
 
-SYNC_SHARED: {
-  my $test : shared;  # simple|repeat|twain
-  my $cond : shared;
-  my $lock : shared;
-
-  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);
+        return($testno);
     }
-    ok(4,1,"$test: child signalled condition");
-  }
 
-  # - TEST cond_timedwait success
+    sub ctw_ok
+    {
+        my ($testnum, $to) = @_;
+
+        # Which lock to obtain?
+        $test_type =~ /twain/ ? lock($lock) : lock($cond);
+        ok($testnum++, 1, "$test_type: obtained initial lock");
+
+        my $thr = threads->create(\&signaller, $testnum);
+        my $ok = 0;
+        for ($test_type) {
+            $ok = cond_timedwait($cond, time() + $to), last        if /simple/;
+            $ok = cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
+            $ok = cond_timedwait($cond, time() + $to, $lock), last if /twain/;
+            die "$test_type: unknown test\n";
+        }
+        $testnum = $thr->join();
+        ok($testnum++, $ok, "$test_type: condition obtained");
 
-  forko( sub {
-    foreach (@wait_how) {
-      $test = "cond_timedwait [$_]";
-      threads->create(\&ctw, 0.05)->join;
-      $Base += 5;
+        return ($testnum);
     }
-  }, 5*@wait_how, 5);
-
-  sub ctw($) {
-      my $to = shift;
-
-      # which lock to obtain?
-      $test =~ /twain/ ? lock($lock) : lock($cond);
-      ok(1,1, "$test: obtained initial lock");
-
-      my $thr = threads->create(\&signaller);
-      my $ok = 0;
-      for ($test) {
-        $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
-        $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
-        $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
-        die "$test: unknown test\n";
-      }
-      $thr->join;
-      ok(5,$ok, "$test: condition obtained");
-  }
-
-  # - TEST cond_timedwait timeout
-
-  forko( sub {
+
     foreach (@wait_how) {
-      $test = "cond_timedwait pause, timeout [$_]";
-      threads->create(\&ctw_fail, 0.3)->join;
-      $Base += 2;
+        $test_type = "cond_timedwait [$_]";
+        my $thr = threads->create(\&ctw_ok, $TEST, 0.05);
+        $TEST = $thr->join();
+    }
+
+    # - TEST cond_timedwait timeout
+
+    sub ctw_fail
+    {
+        my ($testnum, $to) = @_;
+
+        if ($^O eq "hpux" && $Config{osvers} <= 10.20) {
+            # The lock obtaining would pass, but the wait will not.
+            ok($testnum++, 1, "$test_type: obtained initial lock");
+            ok($testnum++, 0, "# SKIP see perl583delta");
+
+        } else {
+            $test_type =~ /twain/ ? lock($lock) : lock($cond);
+            ok($testnum++, 1, "$test_type: obtained initial lock");
+            my $ok;
+            for ($test_type) {
+                $ok = cond_timedwait($cond, time() + $to), last        if /simple/;
+                $ok = cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
+                $ok = cond_timedwait($cond, time() + $to, $lock), last if /twain/;
+                die "$test_type: unknown test\n";
+            }
+            ok($testnum++, ! defined($ok), "$test_type: timeout");
+        }
+
+        return ($testnum);
     }
-  }, 2*@wait_how, 5);
 
-  forko( sub {
     foreach (@wait_how) {
-      $test = "cond_timedwait instant timeout [$_]";
-      threads->create(\&ctw_fail, -0.60)->join;
-      $Base += 2;
+        $test_type = "cond_timedwait pause, timeout [$_]";
+        my $thr = threads->create(\&ctw_fail, $TEST, 0.3);
+        $TEST = $thr->join();
     }
-  }, 2*@wait_how, 5);
-
-  # cond_timedwait timeout (relative timeout)
-  sub ctw_fail {
-    my $to = shift;
-    if ($^O eq "hpux" && $Config{osvers} <= 10.20) {
-      # The lock obtaining would pass, but the wait will not.
-      ok(1,1, "$test: obtained initial lock");
-      ok(2,0, "# SKIP see perl583delta");
-    } else {
-      $test =~ /twain/ ? lock($lock) : lock($cond);
-      ok(1,1, "$test: obtained initial lock");
-      my $ok;
-      my $delta = time();
-      for ($test) {
-        $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
-        $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
-        $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
-        die "$test: unknown test\n";
-      }
-      $delta = time() - $delta;
-      ok(2, ! defined($ok), "$test: timeout");
-
-      if (($to > 0) && ($^O ne 'os2')) {
-        # Timing tests can be problematic
-        if (($delta < (0.9 * $to)) || ($delta > (1.0 + $to))) {
-          print(STDERR "# Timeout: specified=$to  actual=$delta secs.\n");
-        }
-      }
+
+    foreach (@wait_how) {
+        $test_type = "cond_timedwait instant timeout [$_]";
+        my $thr = threads->create(\&ctw_fail, $TEST, -0.60);
+        $TEST = $thr->join();
     }
-  }
 
 } # -- SYNCH_SHARED block
 
@@ -215,109 +197,112 @@ SYNC_SHARED: {
 # same as above, but with references to lock and cond vars
 
 SYNCH_REFS: {
-  my $test : shared;  # simple|repeat|twain
+    my $test_type :shared;   # simple|repeat|twain
 
-  my $true_cond; share($true_cond);
-  my $true_lock; share($true_lock);
+    my $true_cond :shared;
+    my $true_lock :shared;
 
-  my $cond = \$true_cond;
-  my $lock = \$true_lock;
+    my $cond = \$true_cond;
+    my $lock = \$true_lock;
 
-  ok(1, 1, "Synchronization reference tests preparation");
-  $Base += 1;
+    ok($TEST++, 1, "Synchronization reference tests preparation");
 
-  sub signaller2 {
-    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);
+    # - TEST cond_timedwait success
+
+    sub signaller2
+    {
+        my $testno = $_[0];
+
+        ok($testno++, 1, "$test_type: child before lock");
+        $test_type =~ /twain/ ? lock($lock) : lock($cond);
+        ok($testno++, 1, "$test_type: child obtained lock");
+
+        if ($test_type =~ 'twain') {
+            no warnings 'threads';   # lock var != cond var, so disable warnings
+            cond_signal($cond);
+        } else {
+            cond_signal($cond);
+        }
+        ok($testno++, 1, "$test_type: child signalled condition");
+
+        return($testno);
     }
-    ok(4,1,"$test: child signalled condition");
-  }
 
-  # - TEST cond_timedwait success
+    sub ctw_ok2
+    {
+        my ($testnum, $to) = @_;
+
+        # Which lock to obtain?
+        $test_type =~ /twain/ ? lock($lock) : lock($cond);
+        ok($testnum++, 1, "$test_type: obtained initial lock");
+
+        my $thr = threads->create(\&signaller2, $testnum);
+        my $ok = 0;
+        for ($test_type) {
+            $ok = cond_timedwait($cond, time() + $to), last        if /simple/;
+            $ok = cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
+            $ok = cond_timedwait($cond, time() + $to, $lock), last if /twain/;
+            die "$test_type: unknown test\n";
+        }
+        $testnum = $thr->join();
+        ok($testnum++, $ok, "$test_type: condition obtained");
 
-  forko( sub {
-    foreach (@wait_how) {
-      $test = "cond_timedwait [$_]";
-      threads->create(\&ctw2, 0.05)->join;
-      $Base += 5;
+        return ($testnum);
     }
-  }, 5*@wait_how, 5);
-
-  sub ctw2($) {
-      my $to = shift;
-
-      # which lock to obtain?
-      $test =~ /twain/ ? lock($lock) : lock($cond);
-      ok(1,1, "$test: obtained initial lock");
-
-      my $thr = threads->create(\&signaller2);
-      my $ok = 0;
-      for ($test) {
-        $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
-        $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
-        $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
-        die "$test: unknown test\n";
-      }
-      $thr->join;
-      ok(5,$ok, "$test: condition obtained");
-  }
-
-  # - TEST cond_timedwait timeout
-
-  forko( sub {
+
     foreach (@wait_how) {
-      $test = "cond_timedwait pause, timeout [$_]";
-      threads->create(\&ctw_fail2, 0.3)->join;
-      $Base += 2;
+        $test_type = "cond_timedwait [$_]";
+        my $thr = threads->create(\&ctw_ok2, $TEST, 0.05);
+        $TEST = $thr->join();
     }
-  }, 2*@wait_how, 5);
 
-  forko( sub {
-    foreach (@wait_how) {
-      $test = "cond_timedwait instant timeout [$_]";
-      threads->create(\&ctw_fail2, -0.60)->join;
-      $Base += 2;
+    # - TEST cond_timedwait timeout
+
+    sub ctw_fail2
+    {
+        my ($testnum, $to) = @_;
+
+        if ($^O eq "hpux" && $Config{osvers} <= 10.20) {
+            # The lock obtaining would pass, but the wait will not.
+            ok($testnum++, 1, "$test_type: obtained initial lock");
+            ok($testnum++, 0, "# SKIP see perl583delta");
+
+        } else {
+            $test_type =~ /twain/ ? lock($lock) : lock($cond);
+            ok($testnum++, 1, "$test_type: obtained initial lock");
+            my $ok;
+            for ($test_type) {
+                $ok = cond_timedwait($cond, time() + $to), last        if /simple/;
+                $ok = cond_timedwait($cond, time() + $to, $cond), last if /repeat/;
+                $ok = cond_timedwait($cond, time() + $to, $lock), last if /twain/;
+                die "$test_type: unknown test\n";
+            }
+            ok($testnum++, ! defined($ok), "$test_type: timeout");
+        }
+
+        return ($testnum);
     }
-  }, 2*@wait_how, 5);
 
-  sub ctw_fail2 {
-    my $to = shift;
+    foreach (@wait_how) {
+        $test_type = "cond_timedwait pause, timeout [$_]";
+        my $thr = threads->create(\&ctw_fail2, $TEST, 0.3);
+        $TEST = $thr->join();
+    }
 
-    if ($^O eq "hpux" && $Config{osvers} <= 10.20) {
-      # The lock obtaining would pass, but the wait will not.
-      ok(1,1, "$test: obtained initial lock");
-      ok(2,0, "# SKIP see perl583delta");
-    } else {
-      $test =~ /twain/ ? lock($lock) : lock($cond);
-      ok(1,1, "$test: obtained initial lock");
-      my $ok;
-      my $delta = time();
-      for ($test) {
-        $ok=cond_timedwait($cond, time() + $to), last        if    /simple/;
-        $ok=cond_timedwait($cond, time() + $to, $cond), last if    /repeat/;
-        $ok=cond_timedwait($cond, time() + $to, $lock), last if    /twain/;
-        die "$test: unknown test\n";
-      }
-      $delta = time() - $delta;
-      ok(2, ! $ok, "$test: timeout");
-
-      if (($to > 0) && ($^O ne 'os2')) {
-        # Timing tests can be problematic
-        if (($delta < (0.9 * $to)) || ($delta > (1.0 + $to))) {
-          print(STDERR "# Timeout: specified=$to  actual=$delta secs.\n");
-        }
-      }
+    foreach (@wait_how) {
+        $test_type = "cond_timedwait instant timeout [$_]";
+        my $thr = threads->create(\&ctw_fail2, $TEST, -0.60);
+        $TEST = $thr->join();
     }
-  }
 
 } # -- SYNCH_REFS block
 
+# Kill timer process
+if ($timer_pid && kill(0, $timer_pid)) {
+    kill('KILL', $timer_pid);
+}
+
+# Done
 exit(0);
 
 # EOF