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

# this test crashes on Windows 7

mkdir "t/dir1-$$" or die;
mkdir "t/dir2-$$" or die;
mkdir "t/dir2-$$/dir3" or die;

my $END_PID = $$;

my $PERL = $Config{perlpath};  # in case $^X is a relative path ...
$PERL = $^X if ! -x $PERL;

if (${^TAINT}) {
    $ENV{PATH} = '';
    ($PERL)=$PERL=~/(.*)/;
}

my $pid0 = fork { dir => get_path("t/dir2-$$") };
   # ok: $$ is parent pid, not new child pid

if ($pid0 == 0) {
    open my $BAR, '>', 'www';
    print $BAR 'Prey for whirled peas';
    close $BAR;
    exit;
}
ok(isValidPid($pid0), "natural child launched with dir option");
wait;
ok(-f "t/dir2-$$/www", "child called chdir");
ok(-s "t/dir2-$$/www" == length('Prey for whirled peas'), 
   "child created file in target dir");
ok($pid0->status == 0, "child completed normally");
unlink "www", "t/dir2-$$/www";


my $pid1 = fork { 
    dir => get_path("t/dir1-$$"),
    sub => sub { 
	open my $FOO, '>>', 'xxx';
	print $FOO "Hello world";
	close $FOO;
    }
};
ok(isValidPid($pid1), "sub child launched with dir option");
wait;
ok(-f "t/dir1-$$/xxx", "child called chdir");
ok(-s "t/dir1-$$/xxx" == 11, "child created file in target dir");
ok($pid1->status == 0, "child completed normally");
unlink "xxx", "t/dir1-$$/xxx";

my $pid2 = fork {
    chdir => get_path("t/dir2-$$/dir3"),
    exec => [$PERL, "../../external-command.pl", "-o=yyy", "-e=message"]
};
ok(isValidPid($pid2), "exec child launched with chdir option");
wait;
ok(-f "t/dir2-$$/dir3/yyy", "child called chdir");
ok(-s "t/dir2-$$/dir3/yyy", "child created file in target dir");
ok($pid2->status == 0, "child completed normally");
unlink "t/dir2-$$/dir3/yyy", "yyy";

my $pid3 = fork {
    dir => get_path("t/dir56789"),
    cmd => [ $PERL, "../external-command.pl", "-o=zzz", "-e=message" ]
};
ok(isValidPid($pid3), "cmd child launched with invalid dir option");
wait;
ok(! -d "t/dir56789", "child target dir not created");
ok($pid3->status != 0, "child failed with invalid target dir");

sub get_path {
    my $path = shift;
    if (${^TAINT}) {
	$path = Forks::Super::Util::abs_path($path);
	($path) = $path =~ /(.*)/;
    }
    return $path;
}

END {
    if ($$ == $END_PID) {
	unlink "t/dir2-$$/dir3/*";
	rmdir "t/dir2-$$/dir3";
	unlink glob("t/dir2-$$/*");
	rmdir "t/dir2-$$";
	unlink glob("t/dir1-$$/*");
	rmdir "t/dir1-$$";
    }
}