# remove empty elements due to insertion of empty symbols via "''p1'" syntax
@ARGV = grep($_,@ARGV) if $^O eq 'VMS';
+our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
# Cheesy version of Getopt::Std. Maybe we should replace it with that.
{
# Roll your own File::Find!
use TestInit;
use File::Spec;
+if ($show_elapsed_time) { require Time::HiRes }
my $curdir = File::Spec->curdir;
my $updir = File::Spec->updir;
my $tested_files = 0;
my $totmax = 0;
- my $test;
- while ($test = shift @tests) {
+ while (my $test = shift @tests) {
+ my $test_start_time = $show_elapsed_time ? Time::HiRes::time() : 0;
if ( $::infinite{$test} && $type eq 'compile' ) {
print STDERR "$test creates infinite loop! Skipping.\n";
# XXX DAPM %OVER not defined anywhere
# $test = $OVER{$test} if exists $OVER{$test};
- open(SCRIPT,"<$test") or die "Can't run $test.\n";
+ open(SCRIPT,"<",$test) or die "Can't run $test.\n";
$_ = <SCRIPT>;
close(SCRIPT) unless ($type eq 'deparse');
if ($::with_utf16) {
my $perl = $ENV{PERL} || './perl';
my $redir = $^O eq 'VMS' ? '2>&1' : '';
if ($ENV{PERL_VALGRIND}) {
- $perl = "valgrind --suppressions=perl.supp --leak-check=yes "
- . "--leak-resolution=high --show-reachable=yes "
- . "--num-callers=50 --logfile-fd=3 $perl";
+ my $valgrind = $ENV{VALGRIND} // 'valgrind';
+ $perl = "$valgrind --suppressions=perl.supp --leak-check=yes "
+ . "--leak-resolution=high --show-reachable=yes "
+ . "--num-callers=50 --log-fd=3 $perl";
$redir = "3>$valgrind_log";
}
my $run = "$perl" . _quote_args("$testswitch $switch $utf8")
die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
}
else {
+ # module tests are allowed extra output,
+ # because Test::Harness allows it
+ next if $test =~ /^\W*(ext|lib)\b/;
$failure = "FAILED--unexpected output at test $next";
last;
}
}
else {
if ($max) {
- print "${te}ok\n";
+ my $elapsed;
+ if ( $show_elapsed_time ) {
+ $elapsed = sprintf( " %8.0f ms", (Time::HiRes::time() - $test_start_time) * 1000 );
+ }
+ else {
+ $elapsed = "";
+ }
+ print "${te}ok$elapsed\n";
$good_files++;
}
else {
$tested_files -= 1;
}
}
- }
+ } # while tests
if ($::bad_files == 0) {
if ($good_files) {