diff options
author | Vincent Pit <perl@profvince.com> | 2009-08-31 17:05:46 +0200 |
---|---|---|
committer | Vincent Pit <perl@profvince.com> | 2009-08-31 17:05:50 +0200 |
commit | d1fe220a89ae3a3c1578cd8eaad59ad885769cf4 (patch) | |
tree | da133a5c45183e24a295ce67c8db220ce2c63dba | |
parent | 491c95723f4cf3d8c4bab14a98d1a073bcfa3c1e (diff) | |
download | perl-d1fe220a89ae3a3c1578cd8eaad59ad885769cf4.tar.gz |
Forge the test command to execute in a new _cmd() subroutine
-rwxr-xr-x | t/TEST | 55 |
1 files changed, 33 insertions, 22 deletions
@@ -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 |