# do a heavy-duty fire-and-compare loop on all resultsets
# this is expensive - not running on install
my $typecounts = {};
- unless (DBICTest::RunMode->is_plain or $ENV{DBICTEST_IN_PERSISTENT_ENV}) {
+ if (
+ ! DBICTest::RunMode->is_plain
+ and
+ ! $ENV{DBICTEST_IN_PERSISTENT_ENV}
+ ) {
# FIXME - ideally we should be able to just populate an alternative
# registry, subtract everything from the main one, and arrive at
($ENV{PATH}) = $ENV{PATH} =~ /(.+)/;
-my $persistence_tests = {
- PPerl => {
- cmd => [qw/pperl --prefork=1/, __FILE__],
- },
- 'CGI::SpeedyCGI' => {
- cmd => [qw/speedy -- -t5/, __FILE__],
- },
-};
-
-# scgi is smart and will auto-reap after -t amount of seconds
-# pperl needs an actual killer :(
-$persistence_tests->{PPerl}{termcmd} = [
- $persistence_tests->{PPerl}{cmd}[0],
- '--kill',
- @{$persistence_tests->{PPerl}{cmd}}[ 1 .. $#{$persistence_tests->{PPerl}{cmd}} ],
-];
-
+my $persistence_tests;
SKIP: {
skip 'Test already in a persistent loop', 1
if $ENV{DBICTEST_IN_PERSISTENT_ENV};
local $ENV{DBICTEST_IN_PERSISTENT_ENV} = 1;
- require IPC::Open2;
+ $persistence_tests = {
+ PPerl => {
+ cmd => [qw/pperl --prefork=1/, __FILE__],
+ },
+ 'CGI::SpeedyCGI' => {
+ cmd => [qw/speedy -- -t5/, __FILE__],
+ },
+ };
+
+ # scgi is smart and will auto-reap after -t amount of seconds
+ # pperl needs an actual killer :(
+ $persistence_tests->{PPerl}{termcmd} = [
+ $persistence_tests->{PPerl}{cmd}[0],
+ '--kill',
+ @{$persistence_tests->{PPerl}{cmd}}[ 1 .. $#{$persistence_tests->{PPerl}{cmd}} ],
+ ];
+
+ # set up -I
+ require Config;
+ $ENV{PERL5LIB} = join ($Config::Config{path_sep}, @INC);
+
+ # adjust PATH for -T
+ if (length $ENV{PATH}) {
+ ( $ENV{PATH} ) = join ( $Config::Config{path_sep},
+ map { length($_) ? File::Spec->rel2abs($_) : () }
+ split /\Q$Config::Config{path_sep}/, $ENV{PATH}
+ ) =~ /\A(.+)\z/;
+ }
for my $type (keys %$persistence_tests) { SKIP: {
unless (eval "require $type") {
if system(@cmd);
}
+ require IPC::Open2;
+
for (1,2,3) {
note ("Starting run in persistent env ($type pass $_)");
IPC::Open2::open2(my $out, undef, @cmd);
# just an extra precaution in case we blew away from the SKIP - since there are no
# PID files to go by (man does pperl really suck :(
END {
- unless ($ENV{DBICTEST_IN_PERSISTENT_ENV}) {
- close $_ for (*STDIN, *STDOUT, *STDERR);
+ if ($persistence_tests->{PPerl}{termcmd}) {
local $?; # otherwise test will inherit $? of the system()
- system (@{$persistence_tests->{PPerl}{termcmd}})
- if $persistence_tests->{PPerl}{termcmd};
+ require IPC::Open3;
+ open my $null, ">", File::Spec->devnull;
+ waitpid(
+ IPC::Open3::open3(undef, $null, $null, @{$persistence_tests->{PPerl}{termcmd}}),
+ 0,
+ );
}
}