The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

use strict;
use warnings;

if ($^O eq 'MSWin32') {
    Forks::Super::Config::CONFIG_module("Win32::API");
    if ($Win32::API::VERSION && $Win32::API::VERSION < 0.71) {
	warn qq[

Win32::API v$Win32::API::VERSION found. v>=0.71 may be required
to pass this test and use the features exercised by this test.

];
    }
}

#
# tests (24) for exercising bg_eval. This code should
# not be run by itself, but should be <require>'d by
# the test scripts (62ad-bg_eval.t, 62ay-bg_eval.t)
# that wish to run them.
# 

my $t0 = Time::HiRes::time();

# untaint needed when Data::Dumper is the serializer
my $untaint = ${^TAINT};
if ($untaint) {
    my $ipc_dir = Forks::Super::Job::Ipc::_choose_dedicated_dirname();
    if (! eval {$ipc_dir = Cwd::abs_path($ipc_dir)}) {
	$ipc_dir = Cwd::getcwd() . "/" . $ipc_dir;
    }
    ($ipc_dir) = $ipc_dir =~ /(.*)/;
    Forks::Super::Job::Ipc::set_ipc_dir($ipc_dir);
}

my $x = bg_eval { sleep 3 ; return 42 } { untaint => $untaint };
my $t = Time::HiRes::time();
ok(defined $Forks::Super::LAST_JOB,        ### 3 ###
   "\$Forks::Super::LAST_JOB set");
ok(defined $Forks::Super::LAST_JOB_ID, "\$Forks::Super::LAST_JOB_ID set");
ok(Forks::Super::isValidPid($Forks::Super::LAST_JOB_ID), 
   "\$Forks::Super::LAST_JOB_ID set");
ok($Forks::Super::LAST_JOB->{_is_bg} > 0, 
   "\$Forks::Super::LAST_JOB marked bg");
my $p = waitpid -1, 0, 10.0;
ok($p == -1, "waitpid doesn't catch bg_eval job");
ok($x == 42, "scalar bg_eval");   ### 8 ###
my $t1 = Time::HiRes::time();
($t,$t0) = ($t1-$t,$t1-$t0);
my $y = $x;
ok($y == 42, "scalar bg_eval");   ### 9 ###
okl($t0 >= 2.6 && $t <= 7.95,     ### 10 ### was 3.85, obs 3.97,5.11,7.39,2.65
   "scalar bg_eval took ${t}s ${t0}s expected ~3s");
$x = 19;
ok($x == 19, "result is not read only");

my $foo = eval { $x->foo(1,2,3,4) };
ok(!defined($foo) && $@, 'invalid method call');

SKIP: {

    $x = bg_eval { sleep 10; return 19 } { timeout => 2, untaint => $untaint };
    $t = Time::HiRes::time();
    ok(!defined($x->_fetch) || $x eq '',
       "scalar bg_eval undef on failure");
    $t = Time::HiRes::time() - $t;
    okl($t <= 5.25,                    ### 13 ### was 3.25, obs 3.41,4.01,5.01
	"scalar bg_eval respected timeout, took ${t}s expected ~2s");
}

$t0 = Time::HiRes::time();
$x = bg_eval {
    sleep 2;
    opendir(X, "t");
    my $i = 0; my %f = map { $_ => ++$i } grep { !/\.t$/ } readdir(X);
    closedir X;
    return \%f;
} {
    'untaint' => $untaint
};
$t = Time::HiRes::time();
my %others = %$x;
my $t2 = Time::HiRes::time();
($t,$t0) = ($t2-$t,$t2-$t0);
okl($t0 >= 1.95 && $t <= 5.04,           ### 25 ### was 5.04 obs 8.54
    "listref bg_eval took ${t0}s ${t}s expected ~2s");
ok(scalar(keys %others) > 0, "listref bg_eval");
$x = [ "a", "v", "rst" ];
ok(@$x == 3, "listref bg_eval overwrite ok");
waitall;

### test variery of %options ###

$x = 20;
my $w = 14;
$t0 = Time::HiRes::time();
$x = bg_eval {
    sleep 5; return 19
} { name => 'bg_eval_job', delay => 3, on_busy => "queue",
    callback => { queue => sub { $w++ }, start => sub { $w+=2 },
		  finish => sub { $w+=5 } },
    untaint => $untaint
};
$t = Time::HiRes::time();
my $j = Forks::Super::Job::get('bg_eval_job');
ok($j eq $Forks::Super::LAST_JOB, "\$Forks::Super::LAST_JOB updated");
ok($j->{state} eq "DEFERRED", "bg_eval with delay");
ok($w == 14 + 1, "bg_eval job queue callback");
Forks::Super::pause(4);
ok($j->{state} eq "ACTIVE", "bg_eval job left queue " . $j->toString());
ok($w == 14 + 1 + 2, "bg_eval start callback");
ok($x == 19, "scalar bg_eval with lots of options");
$t1 = Time::HiRes::time();
($t,$t0) = ($t1-$t,$t1-$t0);
okl($t0 > 7.60 && $t < 13.5,  ### 34 ### was 9.6 obs 9.99,10.35,11.37,13.20,7.69
   "bg_eval with delay took ${t}s ${t0}s, expected ~8s");
ok($w == 14 + 1 + 2 + 5, "bg_eval finish callback");

1;