From: Vincent Pit Date: Mon, 31 Aug 2009 15:05:46 +0000 (+0200) Subject: Forge the test command to execute in a new _cmd() subroutine X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d1fe220a89ae3a3c1578cd8eaad59ad885769cf4;p=p5sagit%2Fp5-mst-13.2.git Forge the test command to execute in a new _cmd() subroutine --- diff --git a/t/TEST b/t/TEST index 39333af..d20f94e 100755 --- a/t/TEST +++ b/t/TEST @@ -204,33 +204,22 @@ sub _scan_test { }; } -sub _run_test { - my($harness, $test, $type) = @_; - if (!defined $type) { - # To conform to the interface expected by exec in TAP::Harness - $type = 'perl'; - } - - my $options = _scan_test($test, $type); - - $test = $options->{test}; # Might have changed if we're in ext/Foo +sub _cmd { + my($options, $type) = @_; - if ($options->{run_dir}) { - my $run_dir = $options->{run_dir}; - chdir $run_dir or die "Can't chdir to '$run_dir': $!"; - } + my $test = $options->{test}; - my $results; + my $cmd; if ($type eq 'deparse') { my $perl = "$options->{perl} $options->{testswitch}"; my $lib = $options->{lib}; - my $deparse_cmd = + + $cmd = ( "$perl $options->{switch} -I$lib -MO=-qq,Deparse,-sv1.,". "-l$::deparse_opts$options->{file} ". "$test > $test.dp ". - "&& $perl $options->{switch} -I$lib $test.dp |"; - open($results, $deparse_cmd) - or print "can't deparse '$deparse_cmd': $!.\n"; + "&& $perl $options->{switch} -I$lib $test.dp" + ); } elsif ($type eq 'perl') { my $perl = $options->{perl}; @@ -241,16 +230,38 @@ sub _run_test { my $vg_opts = $ENV{VG_OPTS} // "--suppressions=perl.supp --leak-check=yes " . "--leak-resolution=high --show-reachable=yes " - . "--num-callers=50"; + . "--num-callers=50"; $perl = "$valgrind --log-fd=3 $vg_opts $perl"; $redir = "3>$Valgrind_Log"; } my $args = "$options->{testswitch} $options->{switch} $options->{utf8}"; - my $run = $perl . _quote_args($args) . " $test $redir|"; - open($results, $run) or print "can't run '$run': $!.\n"; + $cmd = $perl . _quote_args($args) . " $test $redir"; } + return $cmd; +} + +sub _run_test { + my($harness, $test, $type) = @_; + if (!defined $type) { + # To conform to the interface expected by exec in TAP::Harness + $type = 'perl'; + } + + my $options = _scan_test($test, $type); + + $test = $options->{test}; # Might have changed if we're in ext/Foo + + if ($options->{run_dir}) { + my $run_dir = $options->{run_dir}; + chdir $run_dir or die "Can't chdir to '$run_dir': $!"; + } + + my $cmd = _cmd($options, $type); + + open(my $results, "$cmd |") or print "can't run '$cmd': $!.\n"; + if ($options->{return_dir}) { my $return_dir = $options->{return_dir}; chdir $return_dir