#!perl
use strict;
BEGIN{ if (not $] < 5.006) { require warnings; warnings->import } }
select(STDERR); $|=1;
select(STDOUT); $|=1;
use Test::More;
use t::Helper;
use t::Frontend;
use Config;
use File::Temp ();
use IO::CaptureOutput qw/capture/;
use Probe::Perl ();
#--------------------------------------------------------------------------#
# fixtures
#--------------------------------------------------------------------------#
my $perl = Probe::Perl->find_perl_interpreter();
my $quote = $^O eq 'MSWin32' || $^O eq 'MSDOS' ? q{"} : q{'};
#--------------------------------------------------------------------------#
# Test planning
#--------------------------------------------------------------------------#
my @cases = (
{
label => "Exit with 0",
program => 'print qq{foo\n}; exit 0',
args => '',
output => [ "foo\n" ],
exit_code => 0,
},
{
label => "Exit with 1",
program => 'print qq{foo\n}; exit 1',
args => '',
output => [ "foo\n" ],
exit_code => 1 << 8,
},
{
label => "Exit with 2",
program => 'print qq{foo\n}; exit 2',
args => '',
output => [ "foo\n" ],
exit_code => 2 << 8,
},
{
label => "Exit with args in shell quotes",
program => 'print qq{foo $ARGV[0]\n}; exit 0',
args => "${quote}apples oranges bananas${quote}",
output => [ "foo apples oranges bananas\n" ],
exit_code => 0,
},
{
label => "Exit with args and pipe",
program => 'print qq{foo @ARGV\n}; exit 1',
args => "bar=1 | $perl -pe 0",
output => [ "foo bar=1\n" ],
exit_code => 1 << 8,
},
{
label => "Timeout kills process",
program => '$now=time(); 1 while( time() - $now < 60); print qq{foo\n}; exit 0',
args => '',
output => [],
delay => 60,
timeout => 5,
exit_code => 9,
},
{
label => "Timeout not reached",
program => '$now=time(); 1 while( time() - $now < 2); print qq{foo\n}; exit 0',
args => '',
output => ["foo\n"],
delay => 2,
timeout => 30,
exit_code => 0,
},
{
label => "Timeout not reached (quoted args)",
program => '$now=time(); 1 while( time() - $now < 2); print qq{foo $ARGV[0]\n}; exit 0',
args => "${quote}apples oranges bananas${quote}",
output => [ "foo apples oranges bananas\n" ],
delay => 2,
timeout => 30,
exit_code => 0,
},
);
my $tests_per_case = 4;
plan tests => 1 + $tests_per_case * @cases;
#--------------------------------------------------------------------------#
# tests
#--------------------------------------------------------------------------#
require_ok( "CPAN::Reporter" );
for my $c ( @cases ) {
SKIP: {
if ( $^O eq 'MSWin32' && $c->{timeout} ) {
skip "\$ENV{PERL_AUTHOR_TESTING} required for Win32 timeout testing",
$tests_per_case
unless $ENV{PERL_AUTHOR_TESTING};
eval "use Win32::Job ()";
skip "Win32::Job needed for timeout testing", $tests_per_case
if $@;
}
my $fh = File::Temp->new()
or die "Couldn't create a temporary file: $!\nIs your temp drive full?";
print {$fh} $c->{program}, "\n";
$fh->flush;
my ($output, $exit);
my ($stdout, $stderr);
my $start_time = time();
my $cmd = $perl;
warn "# sleeping for timeout test\n" if $c->{timeout};
eval {
capture sub {
($output, $exit) = CPAN::Reporter::record_command(
"$cmd $fh $c->{args}", $c->{timeout}
);
}, \$stdout, \$stderr;
};
sleep 1; # pad the run time into the next second
my $run_time = time() - $start_time;
diag $@ if $@;
if ( $c->{timeout} ) {
my ($time_ok, $verb, $range);
if ( $c->{timeout} < $c->{delay} ) { # if process should time out
$time_ok = $run_time <= $c->{delay};
$verb = "stopped";
$range = sprintf( "timeout (%d) : ran (%d) : sleep (%d)",
$c->{timeout}, $run_time, $c->{delay}
);
}
else { # process should exit before timeout
$time_ok = $run_time <= $c->{timeout};
$verb = "didn't stop";
$range = sprintf( "sleep (%d) : ran (%d) : timeout (%d)",
$c->{delay}, $run_time, $c->{timeout}
);
}
ok( $time_ok, "$c->{label}: timeout $verb process") or diag $range;
}
else {
pass "$c->{label}: No timeout requested";
}
like( $stdout, "/" . quotemeta(join(q{},@$output)) . "/",
"$c->{label}: captured stdout"
);
is_deeply( $output, $c->{output}, "$c->{label}: output as expected" )
or diag "STDOUT:\n$stdout\n\nSTDERR:\n$stderr\n";
is( $exit, $c->{exit_code}, "$c->{label}: exit code correct" );
} # SKIP
}