use Forks::Super ':test';
use Test::More tests => 17;
use strict;
use warnings;
SKIP: {
if (&Forks::Super::Util::IS_WIN32ish &&
!Forks::Super::Config::CONFIG_module("Win32::API")) {
skip "suspend/resume not supported on $^O - install Win32::API", 17;
}
my $pid = fork {
sub => sub {
for (my $i=0; $i<7; $i++) {
sleep 1;
}
} };
my $j = Forks::Super::Job::get($pid);
ok(isValidPid($pid) && $j->{state} eq "ACTIVE", "$$\\created $pid");
sleep 3;
if ($^O eq 'MSWin32') {
diag("Calling suspend method for $j. This is pid $$.");
}
$j->suspend;
ok($j->{state} eq "SUSPENDED", "job was suspended");
sleep 5;
my $t = Time::HiRes::time();
$j->resume;
ok($j->{state} eq "ACTIVE", "job was resumed");
waitpid $pid,0;
$t = Time::HiRes::time() - $t;
ok($t >= 1.95, "\"time stopped\" while job was suspended, ${t} >= 3s");
#############################################################################
# to test:
# if only suspended jobs are left:
# waitpid|action=wait runs indefinitely
# waitpid|action=fail returns Forks::Super::Wait::ONLY_SUSPENDED_JOBS_LEFT
# waitpid|action=resume restarts the job
$pid = fork {
sub => sub {
$SIG{STOP} = sub {
die "Trapped a signal $_[0] that shouldn\'t be trappable ...\n"
};
sleep 1 for (1..6)
}
};
$j = Forks::Super::Job::get($pid);
sleep 3;
$j->suspend;
$Forks::Super::Wait::WAIT_ACTION_ON_SUSPENDED_JOBS = 'wait';
$t = Time::HiRes::time();
my $p = wait 5.0;
$t = Time::HiRes::time() - $t;
ok($p == &Forks::Super::Wait::TIMEOUT, ### 5 ###
"wait|wait times out $p==TIMEOUT");
okl($t > 4.95, ### 6 ###
"wait|wait times out ${t}s, expected ~5s");
ok($j->{state} eq 'SUSPENDED', ### 7 ###
"wait|wait does not resume job");
$Forks::Super::Wait::WAIT_ACTION_ON_SUSPENDED_JOBS = 'fail';
$t = Time::HiRes::time();
$p = wait 5.0;
$t = Time::HiRes::time() - $t;
ok($p == &Forks::Super::Wait::ONLY_SUSPENDED_JOBS_LEFT, ### 8 ###
"wait|fail returns invalid");
okl($t < 1.95, "fast fail ${t}s expected <1s");
ok($j->{state} eq 'SUSPENDED', ### 10 ###
"wait|fail does not resume job");
$Forks::Super::Wait::WAIT_ACTION_ON_SUSPENDED_JOBS = 'resume';
$t = Time::HiRes::time();
$p = wait 10.0;
$t = Time::HiRes::time() - $t;
ok($p == $pid, ### 11 ###
"wait|resume makes a process complete");
okl($t > 0.95 && $t < 9, ### 12 ###
"job completes before wait timeout ${t}s, expected 3-4s"); # obs 0.9995
ok($j->{state} eq "REAPED", "job is complete");
##################################################################
# if you suspend a job more than once, and then resume it,
# it should resume. In the basic Windows API, you'd need to
# call resume more than once, too.
$pid = fork { sub => sub { sleep 1 for (1..4) } };
$j = Forks::Super::Job::get($pid);
sleep 1;
ok($j->{state} eq 'ACTIVE', "created bg job, currently active");
$j->suspend;
ok($j->{state} eq 'SUSPENDED', "suspended bg job successfully");
$j->suspend; # re-suspending a job generates a warning.
$j->suspend;
$j->suspend;
$j->suspend;
ok($j->{state} eq 'SUSPENDED', "multiply-suspended bg job successfully");
sleep 1;
$j->resume;
ok($j->{state} eq 'ACTIVE', "single resume reactivated bg job");
waitall;
} # end SKIP
#############################################################################
# ACTIVE + SIGSTOP --> SUSPENDED
# DEFERRED + SIGSTOP --> SUSPENDED-DEFERRED
# SUSPENDED + SIGCONT --> ACTIVE
# SUSPENDED-DEFERRED + SIGCONT -> DEFERRED or ACTIVE
# MSWin32 check STOP+STOP+STOP+STOP+CONT --> ACTIVE