# exercise -MForks::Super=cleanse
#
# run some programs that create IPC files
# 1. when the programs run normally, there should be no IPC litter
# 2. when the programs are interrupted, there may be IPC litter
# 3. after we run cleanse, there should be no IPC litter
use Test::More tests => 5;
$ENV{IPC_DIR} = "t/out/ipc_dir.$$";
mkdir $ENV{IPC_DIR};
my @inc = map { "-I$_" } @INC;
if (${^TAINT}) {
delete $ENV{PATH};
delete $ENV{ENV};
use Config;
$^X = $Config::Config{perlpath};
}
ok(!has_litter(), "no litter initially");
run_jobs(0);
ok(!has_litter(), "no litter after normal run");
run_jobs(1);
ok(has_litter(), "litter after interrupted run");
# the -e 1 should be optional? But on linux with Perl v5.8 I get a
# << Can't stat script "-" >> error?
$c1 = system($^X, @inc, "-MForks::Super=cleanse,$ENV{IPC_DIR}", '-e', 1);
ok($c1==0, "successfully ran Forks::Super in cleanse mode");
ok(!has_litter(), "no litter after cleanse");
rmdir "t/out/ipc_dir.$$";
unlink "t/out/70.$$.pl";
sub has_litter {
opendir my $dh, $ENV{IPC_DIR};
my @files = readdir($dh);
closedir $dh;
return @files > 2;
}
sub run_jobs {
my ($suppress_cleanup) = @_;
my $script = "t/out/70.$$.pl";
open T70, '>', $script;
print T70 <<'__EOF__';
use Forks::Super;
my $job = fork {
child_fh => "all,block",
sub => sub {
my $x = <STDIN>;
print STDOUT $x;
print STDERR $x;
# sleep 2
},
timeout => 10
};
print {$job->{child_stdin}} "foo\n";
my $y = $job->read_stdout();
my $z = $job->read_stderr();
$job->wait;
__EOF__
;
close T70;
# print "program:\n---------------\n$prog\n----------------\n\n";
my $pid = CORE::fork();
if ($pid == 0) {
local $ENV{FORKS_DONT_CLEANUP} = $suppress_cleanup;
exec($^X, @inc, $script);
exit 0;
}
my $pid2 = wait;
#print "wait returned $pid2 after ${t}s\n";
sleep 5; # ipc cleanup may take a short while
# even after program ostensibly ends
return;
}