Hi
I'm using this code in the tests for CGI::Snapp, with pre-reqs:
'Capture::Tiny' => 0.22,
'Carp' => 1.20,
'CGI' => 3.63,
'CGI::PSGI' => 0.15,
'CGI::Simple' => 1.113,
'Class::ISA' => 0.36,
'Data::Dumper::Concise' => 2.020,
'File::Spec' => 3.40,
'Hash::FieldHash' => 0.14,
'IO::Pipe' => 1.14,
'Log::Handler' => 0.78,
'parent' => 0.225,
'Proc::Fork' => 0.802,
'strict' => 1.03,
'Try::Tiny' => 0.16,
'vars' => 1.01,
'warnings' => 1.03,
sub run_script
{
my($self, $script) = @_;
my($pipe) = IO::Pipe -> new;
my(@stack);
run_fork
{
parent
{
my($child) = @_;
waitpid $child, 0;
$pipe -> reader;
push @stack, $_ while <$pipe>;
}
child
{
my($stdout, $stderr, @result) = capture{system($^X, $script)};
$pipe -> writer;
print $pipe $stdout;
exit;
}
error
{
croak "Testing script $script\n";
}
};
return [@stack];
} # End of run_script;
Here's some output reported by Alexandr Ciornii
# Running basic.pl
not ok 1 - run() in basic.pl returned real data
# Failed test 'run() in basic.pl returned real data'
# at t/test.t line 17.
not ok 2 - basic.pl ran 0 tests
# Failed test 'basic.pl ran 0 tests'
# at t/test.t line 31.
# got: '0'
# expected: '4'
# Running callbacks.pl
not ok 3 - run() in callbacks.pl returned real data
# Failed test 'run() in callbacks.pl returned real data'
# at t/test.t line 17.
not ok 4 - callbacks.pl ran 0 tests
# Failed test 'callbacks.pl ran 0 tests'
# at t/test.t line 31.
# got: '0'
# expected: '13'
# Running defaults.pl
not ok 5 - run() in defaults.pl returned real data
# Failed test 'run() in defaults.pl returned real data'
# at t/test.t line 17.
not ok 6 - defaults.pl ran 0 tests
# Failed test 'defaults.pl ran 0 tests'
# at t/test.t line 31.
# got: '0'
# expected: '6'
# Running headers.pl
not ok 7 - run() in headers.pl returned real data
# Failed test 'run() in headers.pl returned real data'
# at t/test.t line 17.
not ok 8 - headers.pl ran 0 tests
# Failed test 'headers.pl ran 0 tests'
# at t/test.t line 31.
# got: '0'
# expected: '17'
# Running hook.tests.pl
(hangs)
The counts got/expected are lines of output. Can't explain that problem
either, but the hang is worse.
Any ideas?
--
Ron Savage
http://savage.net.au/
Ph: 0421 920 622