The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Forks::Super ':test';
use POSIX ':sys_wait_h';
use Test::More tests => 143;
use strict;
use warnings;

#
# tests the Forks::Super::waitpid call.
#

$ENV{TEST_LENIENT} = 1 if $^O =~ /freebsd|midnightbsd|openbsd/;

my $pid = fork { sub => sub { sleep 2 ; exit 2 } };
ok(isValidPid($pid), "$$\\fork successful");
sleep 5;
my $t = Time::HiRes::time();
my $p = waitpid $pid, WNOHANG;
# XXX - should waitpid return -1 or 0 for an active job?
if (($p == -1 || $p == 0) && $^O =~ /bsd/i) {
    # eek. This happens half the time on loaded BSD systems ...
    print STDERR "BSD: need to retry waitpid WNOHANG\n";
    $p = waitpid $pid, WNOHANG;
}
$t = Time::HiRes::time() - $t;
my $s = $?;
if ($p != $pid) {
    # XXX should waitpid return -1 or 0 for an active job?
    if ($p == -1 || $p == 0) {
	my $j = Forks::Super::Job::get($pid);
	my $state1 = $j->{state};
	my $tt = Time::HiRes::time();
	$p = waitpid $pid, 0;
	$s = $?;
	my $state2 = $j->{state};
	$tt = Time::HiRes::time() - $tt;
    }
  SKIP: {
      if ($p == $pid) {
	  ok($p == $pid, "waitpid on $pid returns $p (after delay)");
      } else {
	  skip "waitpid on $pid should return $pid", 1;
      }
    }
} else {
    ok($p == $pid, "waitpid on $pid returns $p");
}
okl($t <= 1, "fast waitpid took ${t}s, expected <=1s");
ok($s == 512, "waitpid captured exit status")
   or diag("status was $s, expected 512");

############################################

$pid = fork { sub => sub { sleep 3; exit 3 } };
ok(isValidPid($pid), "fork successful");
$t = Time::HiRes::time();

# XXX  waitpid WNOHANG on active process should return 0 or -1 ?
$p = waitpid $pid,WNOHANG;
ok($p == -1 || $p == 0, "non-blocking waitpid returned $p, expected 0/-1");
ok(-1 == waitpid ($pid + 10, WNOHANG), "return -1 for invalid target");
ok(-1 == waitpid ($pid + 10, 0), "quick return -1 for invalid target");
$t = Time::HiRes::time() - $t;
okl($t <= 1.1, "fast return ${t}s for invalid target expected <=1s"); ### 9 ###
$t = Time::HiRes::time();
$p = waitpid $pid, 0;
$t = Time::HiRes::time() - $t;
$s = $?;
ok($p==$pid, "blocking waitpid returned real pid");
okl($t >= 2.05, "blocked return took ${t}s expected 3s");
ok($s == 768, "waitpid captured exit status");

############################################

my %x;
$Forks::Super::MAX_PROC = 100;
my @rand = map { rand } 0..19;
my $t0 = Time::HiRes::time();
my $i;
for ($i=0; $i<20 && $i<$Forks::Super::SysInfo::MAX_FORK/2; $i++) {
    # OpenBSD failure point?
    my $pid = fork { sub => sub {my $d=int(2+8*$rand[$i]); sleep $d; exit $i} };
    ok(isValidPid($pid), "Launched $pid"); ### 13-32 ###
    $x{$pid} = $i;
}
for ($i..19) {
    ok(1, 'max fork: skip isValidPid test');
    ok(1, 'max fork: skip reaped test');
    ok(1, 'max fork: skip exit code test');
}
$t = Time::HiRes::time();
while (0 < scalar keys %x) {

    my $p;
    my $pid = (keys %x)[rand() * scalar keys %x];
    if (defined $x{$pid}) {
	if (rand() > 0.5) {
	    $p = waitpid $pid, 0;
	} else {
	    $p = waitpid $pid, WNOHANG;
	}
	if (isValidPid($p)) {
	    ok($p == $pid, "Reaped $p");       ### 33,35,...,71 ###
	    my $exit_code = $? >> 8;
	    ok($exit_code == $x{$p},           ### 34,36,...,72 ###
	       "$p correct exit code $x{$p} == $exit_code STATUS");
	    delete $x{$p};
	}
    } else {
	# warn "pid $pid invalid --- trying again";
    }
}

my $t2 = Time::HiRes::time();
($t0,$t) = ($t2-$t0, $t2-$t);

# freebsd is the biggest offender for taking more than 10s? Where is the
# additional delay coming from?  waitpid ?  pause ?  needs more study.

okl($t0 >= 5.0 && $t <= 13.25,             ### 73 ### was 10.0, obs 11.83,13.55
   "waitpid on multi-procs took ${t}s ${t0}s, expected 6-10s");
$t = Time::HiRes::time();

for (my $i=0; $i<5; $i++) {
    my $p = waitpid -1, 0;
    ok($p == -1, "wait on nothing gives -1, $p");
}
$t = Time::HiRes::time() - $t;

okl($t <= 1, "fast waitpid on nothing took ${t}s, expected <=1s");

############################################

# waitpid 0 or -1 ?
# waitpid -t  for valid/invalid  pgid.

%x = ();

@rand = ();
for ($i=0; $i<20 && $i<$Forks::Super::SysInfo::MAX_FORK/2; $i++) {
    my $rand = rand;
    push @rand, $rand;
    my $pid = fork { sub => sub {	my $d = int(6+5*$rand);
				sleep $d; exit $i } };
    ok(isValidPid($pid), "Launched $pid");
    $x{$pid} = $i;
}
for ($i..19) {
    ok(1, 'max fork: skip isValidPid test');
    ok(1, 'max fork: skip reaped pid valid test');
    ok(1, 'max fork: skip exit code test');
}

$t = Time::HiRes::time();
SKIP: {
    if (!$Forks::Super::SysInfo::CONFIG{'getpgrp'}
	    && $^O ne 'MSWin32') {
	skip "$^O,$]: Can't test waitpid on pgid", 44;
    }

    my $pgid = $^O eq 'MSWin32' ? $$ : getpgrp();
    my $bogus_pgid = $pgid + 175;
    ok(-1 == waitpid (-$bogus_pgid, 0), "bogus pgid");
    ok(-1 == waitpid (-$bogus_pgid, WNOHANG), "bogus pgid");
    my $u = Time::HiRes::time() - $t;
    okl($u <= 1,                                                ### 102 ###
	"fast return ${u}s wait on bogus pgid expected <=1s");

    while (0 < scalar keys %x) {

	my $p;
	my $z = rand();
	if ($z > 0.75) {
	    $p = waitpid 0, WNOHANG;
	} elsif ($z > 0.5) {
	    $p = waitpid -$pgid, WNOHANG; 
	} elsif ($z > 0.25) {
	    $p = waitpid 0, 0;
	} else {
	    $p = waitpid -$pgid, 0;
	}
	if ($p == -1 && $z <= 0.5) {
	    ok(0, "waitpid did not block $z");
	    ok(0, "and now we can't retrieve status of pid we didn't retrieve");
	} elsif (defined $x{$p}) {
	    ok(isValidPid($p), "Reaped $p");
	    ok($? >> 8 == $x{$p}, 
	       "$p correct exit STATUS $x{$p} == " . ($?>>8));
	    delete $x{$p};
	} else {
	    # warn "pid $pid invalid --- trying again\n"; 
	    # this is nothing to be alarmed about
	}
    }

    $t = Time::HiRes::time() - $t;
    if ($t < 7) {
	# if all values are < 1/5, then this test would not pass
	print STDERR "Random values to sleepy fork calls were: @rand\n";
    }
    ok($t > 6.25 && $t < 14.5,  ### 143 ### was 11 obs 11.84,12.62,14.62
       "Took $t s to reap all. Should take about 7-11s");
} # end SKIP