summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2005-06-21 17:05:01 +0000
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2005-06-21 17:05:01 +0000
commitca09b0215ac24a6274ba2f802c2fc35a5abc44e1 (patch)
tree19480518968b9aca02c785572c0745b007229b52
parent74559c0f40be80ce5bdc1a26f97f20d7b2361b77 (diff)
downloadperl-ca09b0215ac24a6274ba2f802c2fc35a5abc44e1.tar.gz
Upgrade to Test::Harness 2.49_02
p4raw-id: //depot/perl@24932
-rw-r--r--lib/Test/Harness.pm73
-rw-r--r--lib/Test/Harness/Changes13
-rw-r--r--lib/Test/Harness/Iterator.pm2
-rw-r--r--lib/Test/Harness/Straps.pm3
-rw-r--r--lib/Test/Harness/t/test-harness.t3
5 files changed, 66 insertions, 28 deletions
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index fcf59dd2f1..99abb0ceaa 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -10,6 +10,13 @@ use Benchmark;
use Config;
use strict;
+use vars '$has_time_hires';
+
+BEGIN {
+ eval "use Time::HiRes 'time'";
+ $has_time_hires = !$@;
+}
+
use vars qw(
$VERSION
@ISA @EXPORT @EXPORT_OK
@@ -27,11 +34,11 @@ Test::Harness - Run Perl standard test scripts with statistics
=head1 VERSION
-Version 2.48
+Version 2.49_02
=cut
-$VERSION = "2.48";
+$VERSION = "2.49_02";
# Backwards compatibility for exportable variable names.
*verbose = *Verbose;
@@ -322,7 +329,7 @@ sub _run_all_tests {
my @dir_files;
@dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
- my $t_start = new Benchmark;
+ my $run_start_time = new Benchmark;
my $width = _leader_width(@tests);
foreach my $tfile (@tests) {
@@ -338,8 +345,12 @@ sub _run_all_tests {
if ( $Test::Harness::Debug ) {
print "# Running: ", $Strap->_command_line($tfile), "\n";
}
+ my $test_start_time = time;
my %results = $Strap->analyze_file($tfile) or
do { warn $Strap->{error}, "\n"; next };
+ my $test_end_time = time;
+ my $elapsed = $test_end_time - $test_start_time;
+ $elapsed = $has_time_hires ? sprintf( " %8.3fs", $elapsed ) : "";
# state of the current test.
my @failed = grep { !$results{details}[$_-1]{ok} }
@@ -365,19 +376,23 @@ sub _run_all_tests {
my($estatus, $wstatus) = @results{qw(exit wait)};
if ($results{passing}) {
+ # XXX Combine these first two
if ($test{max} and $test{skipped} + $test{bonus}) {
my @msg;
push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")
if $test{skipped};
push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded")
if $test{bonus};
- print "$test{ml}ok\n ".join(', ', @msg)."\n";
- } elsif ($test{max}) {
- print "$test{ml}ok\n";
- } elsif (defined $test{skip_all} and length $test{skip_all}) {
+ print "$test{ml}ok$elapsed\n ".join(', ', @msg)."\n";
+ }
+ elsif ( $test{max} ) {
+ print "$test{ml}ok$elapsed\n";
+ }
+ elsif ( defined $test{skip_all} and length $test{skip_all} ) {
print "skipped\n all skipped: $test{skip_all}\n";
$tot{skipped}++;
- } else {
+ }
+ else {
print "skipped\n all skipped: no reason given\n";
$tot{skipped}++;
}
@@ -415,7 +430,8 @@ sub _run_all_tests {
estat => '',
wstat => '',
};
- } else {
+ }
+ else {
print "Don't know which tests failed: got $test{ok} ok, ".
"expected $test{max}\n";
$failedtests{$tfile} = { canon => '??',
@@ -428,7 +444,8 @@ sub _run_all_tests {
};
}
$tot{bad}++;
- } else {
+ }
+ else {
print "FAILED before any test output arrived\n";
$tot{bad}++;
$failedtests{$tfile} = { canon => '??',
@@ -454,7 +471,7 @@ sub _run_all_tests {
}
}
} # foreach test
- $tot{bench} = timediff(new Benchmark, $t_start);
+ $tot{bench} = timediff(new Benchmark, $run_start_time);
$Strap->_restore_PERL5LIB;
@@ -479,13 +496,15 @@ sub _mk_leader {
chomp($te);
$te =~ s/\.\w+$/./;
- if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; }
- my $blank = (' ' x 77);
+ if ($^O eq 'VMS') {
+ $te =~ s/^.*\.t\./\[.t./s;
+ }
my $leader = "$te" . '.' x ($width - length($te));
my $ml = "";
- $ml = "\r$blank\r$leader"
- if -t STDOUT and not $ENV{HARNESS_NOTTY} and not $Verbose;
+ if ( -t STDOUT and not $ENV{HARNESS_NOTTY} and not $Verbose ) {
+ $ml = "\r" . (' ' x 77) . "\r$leader"
+ }
return($leader, $ml);
}
@@ -522,13 +541,16 @@ sub _show_results {
if (_all_ok($tot)) {
print "All tests successful$bonusmsg.\n";
- } elsif (!$tot->{tests}){
+ }
+ elsif (!$tot->{tests}){
die "FAILED--no tests were run for some reason.\n";
- } elsif (!$tot->{max}) {
+ }
+ elsif (!$tot->{max}) {
my $blurb = $tot->{tests}==1 ? "script" : "scripts";
die "FAILED--$tot->{tests} test $blurb could be run, ".
"alas--no output ever seen\n";
- } else {
+ }
+ else {
$pct = sprintf("%.2f", $tot->{good} / $tot->{tests} * 100);
my $percent_ok = 100*$tot->{ok}/$tot->{max};
my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
@@ -764,11 +786,7 @@ sub _canonfailed ($$@) {
if (@failed) {
for (@failed, $failed[-1]) { # don't forget the last one
if ($_ > $last+1 || $_ == $last) {
- if ($min == $last) {
- push @canon, $last;
- } else {
- push @canon, "$min-$last";
- }
+ push @canon, ($min == $last) ? $last : "$min-$last";
$min = $_;
}
$last = $_;
@@ -776,7 +794,8 @@ sub _canonfailed ($$@) {
local $" = ", ";
push @result, "FAILED tests @canon\n";
$canon = join ' ', @canon;
- } else {
+ }
+ else {
push @result, "FAILED test $last\n";
$canon = $last;
}
@@ -784,7 +803,8 @@ sub _canonfailed ($$@) {
push @result, "\tFailed $failed/$max tests, ";
if ($max) {
push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
- } else {
+ }
+ else {
push @result, "?% okay";
}
my $ender = 's' x ($skipped > 1);
@@ -794,7 +814,8 @@ sub _canonfailed ($$@) {
if ($max) {
my $goodper = sprintf("%.2f",100*($good/$max));
$skipmsg .= "$goodper%)";
- } else {
+ }
+ else {
$skipmsg .= "?%)";
}
push @result, $skipmsg;
diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes
index db494a3c94..6efac351da 100644
--- a/lib/Test/Harness/Changes
+++ b/lib/Test/Harness/Changes
@@ -1,5 +1,18 @@
Revision history for Perl extension Test::Harness
+2.49_02 Tue Jun 21 09:54:44 CDT 2005
+ [FIXES]
+ * Added some includes in t/test_harness.t to make Cygwin happy.
+
+2.49_01 Fri Jun 10 15:37:31 CDT 2005
+ [ENHANCEMENTS]
+ * Now shows elapsed time in 1000ths of a second if Time::HiRes
+ is available.
+
+ [FIXES]
+ * Test::Harness::Iterator didn't have a 1; at the end. Thanks to
+ Steve Peters for finding it.
+
2.48 Fri Apr 22 22:41:46 CDT 2005
Released after weeks of non-complaint.
diff --git a/lib/Test/Harness/Iterator.pm b/lib/Test/Harness/Iterator.pm
index 00caf9e55e..2648cea707 100644
--- a/lib/Test/Harness/Iterator.pm
+++ b/lib/Test/Harness/Iterator.pm
@@ -66,3 +66,5 @@ sub next {
my $self = shift;
return $self->{array}->[$self->{idx}++];
}
+
+"Steve Peters, Master Of True Value Finding, was here.";
diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm
index a2b388b6d1..74ddaa57ba 100644
--- a/lib/Test/Harness/Straps.pm
+++ b/lib/Test/Harness/Straps.pm
@@ -457,7 +457,8 @@ sub _filtered_INC {
# toss the ones that involve perl_root, the install location
@inc = grep !/perl_root/i, @inc;
- } elsif ( $self->{_is_win32} ) {
+ }
+ elsif ( $self->{_is_win32} ) {
# Lose any trailing backslashes in the Win32 paths
s/[\\\/+]$// foreach @inc;
}
diff --git a/lib/Test/Harness/t/test-harness.t b/lib/Test/Harness/t/test-harness.t
index 5662a16ba0..d07c43243d 100644
--- a/lib/Test/Harness/t/test-harness.t
+++ b/lib/Test/Harness/t/test-harness.t
@@ -472,7 +472,8 @@ my %samples = (
plan tests => (keys(%samples) * 8);
use Test::Harness;
-$Test::Harness::Switches = '"-Mstrict"';
+my @_INC = map { qq{"-I$_"} } @INC;
+$Test::Harness::Switches = "@_INC -Mstrict";
tie *NULL, 'Dev::Null' or die $!;