X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTest%2FHarness.pm;h=99abb0ceaad5f6882602a0d94fab89a73496d2cc;hb=ca09b0215ac24a6274ba2f802c2fc35a5abc44e1;hp=5596ecd584ee3d1a4182e38f22e5a49cd2e16fee;hpb=3c87ea76a29c989d68c834cb6f9fd80a9892d62a;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 5596ecd..99abb0c 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.46 +Version 2.49_02 =cut -$VERSION = "2.46"; +$VERSION = "2.49_02"; # Backwards compatibility for exportable variable names. *verbose = *Verbose; @@ -39,10 +46,12 @@ $VERSION = "2.46"; *debug = *Debug; $ENV{HARNESS_ACTIVE} = 1; +$ENV{HARNESS_VERSION} = $VERSION; END { # For VMS. delete $ENV{HARNESS_ACTIVE}; + delete $ENV{HARNESS_VERSION}; } # Some experimental versions of OS/2 build have broken $? @@ -320,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) { @@ -336,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} } @@ -363,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}++; } @@ -413,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 => '??', @@ -426,7 +444,8 @@ sub _run_all_tests { }; } $tot{bad}++; - } else { + } + else { print "FAILED before any test output arrived\n"; $tot{bad}++; $failedtests{$tfile} = { canon => '??', @@ -452,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; @@ -477,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); } @@ -520,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.", @@ -762,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 = $_; @@ -774,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; } @@ -782,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); @@ -792,7 +814,8 @@ sub _canonfailed ($$@) { if ($max) { my $goodper = sprintf("%.2f",100*($good/$max)); $skipmsg .= "$goodper%)"; - } else { + } + else { $skipmsg .= "?%)"; } push @result, $skipmsg; @@ -852,15 +875,26 @@ the script dies with this message. =back -=head1 ENVIRONMENT +=head1 ENVIRONMENT VARIABLES THAT TEST::HARNESS SETS + +Test::Harness sets these before executing the individual tests. =over 4 =item C -Harness sets this before executing the individual tests. This allows -the tests to determine if they are being executed through the harness -or by any other means. +This is set to a true value. It allows the tests to determine if they +are being executed through the harness or by any other means. + +=item C + +This is the version of Test::Harness. + +=back + +=head1 ENVIRONMENT VARIABLES THAT AFFECT TEST::HARNESS + +=over 4 =item C