Upgrade to Test::Harness 2.49_02
[p5sagit/p5-mst-13.2.git] / lib / Test / Harness.pm
index b954626..99abb0c 100644 (file)
@@ -1,9 +1,8 @@
 # -*- Mode: cperl; cperl-indent-level: 4 -*-
-# $Id: Harness.pm,v 1.45 2003/04/13 03:34:09 andy Exp $
 
 package Test::Harness;
 
-require 5.004;
+require 5.00405;
 use Test::Harness::Straps;
 use Test::Harness::Assert;
 use Exporter;
@@ -11,24 +10,48 @@ use Benchmark;
 use Config;
 use strict;
 
-use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest
-            $Columns $verbose $switches $ML $Strap
-            @ISA @EXPORT @EXPORT_OK
-           );
+use vars '$has_time_hires';
 
-# Backwards compatibility for exportable variable names.
-*verbose  = \$Verbose;
-*switches = \$Switches;
+BEGIN {
+    eval "use Time::HiRes 'time'";
+    $has_time_hires = !$@;
+}
+
+use vars qw(
+    $VERSION 
+    @ISA @EXPORT @EXPORT_OK 
+    $Verbose $Switches $Debug
+    $verbose $switches $debug
+    $Curtest
+    $Columns 
+    $ML $Last_ML_Print
+    $Strap
+);
+
+=head1 NAME
+
+Test::Harness - Run Perl standard test scripts with statistics
 
-$Have_Devel_Corestack = 0;
+=head1 VERSION
 
-$VERSION = '2.27_04';
+Version 2.49_02
+
+=cut
+
+$VERSION = "2.49_02";
+
+# Backwards compatibility for exportable variable names.
+*verbose  = *Verbose;
+*switches = *Switches;
+*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 $?
@@ -38,20 +61,18 @@ my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
 
 $Strap = Test::Harness::Straps->new;
 
+sub strap { return $Strap };
+
 @ISA = ('Exporter');
 @EXPORT    = qw(&runtests);
 @EXPORT_OK = qw($verbose $switches);
 
 $Verbose  = $ENV{HARNESS_VERBOSE} || 0;
+$Debug    = $ENV{HARNESS_DEBUG} || 0;
 $Switches = "-w";
 $Columns  = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
 $Columns--;             # Some shells have trouble with a full line of text.
 
-
-=head1 NAME
-
-Test::Harness - run perl standard test scripts with statistics
-
 =head1 SYNOPSIS
 
   use Test::Harness;
@@ -60,175 +81,31 @@ Test::Harness - run perl standard test scripts with statistics
 
 =head1 DESCRIPTION
 
-B<STOP!> If all you want to do is write a test script, consider using
-Test::Simple.  Otherwise, read on.
-
-(By using the Test module, you can write test scripts without
-knowing the exact output this module expects.  However, if you need to
-know the specifics, read on!)
-
-Perl test scripts print to standard output C<"ok N"> for each single
-test, where C<N> is an increasing sequence of integers. The first line
-output by a standard test script is C<"1..M"> with C<M> being the
-number of tests that should be run within the test
-script. Test::Harness::runtests(@tests) runs all the testscripts
-named as arguments and checks standard output for the expected
-C<"ok N"> strings.
-
-After all tests have been performed, runtests() prints some
-performance statistics that are computed by the Benchmark module.
-
-=head2 The test script output
-
-The following explains how Test::Harness interprets the output of your
-test program.
-
-=over 4
-
-=item B<'1..M'>
-
-This header tells how many tests there will be.  For example, C<1..10>
-means you plan on running 10 tests.  This is a safeguard in case your
-test dies quietly in the middle of its run.
-
-It should be the first non-comment line output by your test program.
-
-In certain instances, you may not know how many tests you will
-ultimately be running.  In this case, it is permitted for the 1..M
-header to appear as the B<last> line output by your test (again, it
-can be followed by further comments).
-
-Under B<no> circumstances should 1..M appear in the middle of your
-output or more than once.
-
-
-=item B<'ok', 'not ok'.  Ok?>
-
-Any output from the testscript to standard error is ignored and
-bypassed, thus will be seen by the user. Lines written to standard
-output containing C</^(not\s+)?ok\b/> are interpreted as feedback for
-runtests().  All other lines are discarded.
-
-C</^not ok/> indicates a failed test.  C</^ok/> is a successful test.
-
-
-=item B<test numbers>
-
-Perl normally expects the 'ok' or 'not ok' to be followed by a test
-number.  It is tolerated if the test numbers after 'ok' are
-omitted. In this case Test::Harness maintains temporarily its own
-counter until the script supplies test numbers again. So the following
-test script
-
-    print <<END;
-    1..6
-    not ok
-    ok
-    not ok
-    ok
-    ok
-    END
-
-will generate
-
-    FAILED tests 1, 3, 6
-    Failed 3/6 tests, 50.00% okay
-
-=item B<test names>
-
-Anything after the test number but before the # is considered to be
-the name of the test.
-
-  ok 42 this is the name of the test
-
-Currently, Test::Harness does nothing with this information.
-
-=item B<Skipping tests>
+B<STOP!> If all you want to do is write a test script, consider
+using Test::Simple.  Test::Harness is the module that reads the
+output from Test::Simple, Test::More and other modules based on
+Test::Builder.  You don't need to know about Test::Harness to use
+those modules.
 
-If the standard output line contains the substring C< # Skip> (with
-variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
-counted as a skipped test.  If the whole testscript succeeds, the
-count of skipped tests is included in the generated output.
-C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason
-for skipping.
+Test::Harness runs tests and expects output from the test in a
+certain format.  That format is called TAP, the Test Anything
+Protocol.  It is defined in L<Test::Harness::TAP>.
 
-  ok 23 # skip Insufficient flogiston pressure.
-
-Similarly, one can include a similar explanation in a C<1..0> line
-emitted if the test script is skipped completely:
-
-  1..0 # Skipped: no leverage found
-
-=item B<Todo tests>
-
-If the standard output line contains the substring C< # TODO> after
-C<not ok> or C<not ok NUMBER>, it is counted as a todo test.  The text
-afterwards is the thing that has to be done before this test will
-succeed.
-
-  not ok 13 # TODO harness the power of the atom
-
-=begin _deprecated
-
-Alternatively, you can specify a list of what tests are todo as part
-of the test header.
-
-  1..23 todo 5 12 23
-
-This only works if the header appears at the beginning of the test.
-
-This style is B<deprecated>.
-
-=end _deprecated
-
-These tests represent a feature to be implemented or a bug to be fixed
-and act as something of an executable "thing to do" list.  They are
-B<not> expected to succeed.  Should a todo test begin succeeding,
-Test::Harness will report it as a bonus.  This indicates that whatever
-you were supposed to do has been done and you should promote this to a
-normal test.
-
-=item B<Bail out!>
-
-As an emergency measure, a test script can decide that further tests
-are useless (e.g. missing dependencies) and testing should stop
-immediately. In that case the test script prints the magic words
-
-  Bail out!
-
-to standard output. Any message after these words will be displayed by
-C<Test::Harness> as the reason why testing is stopped.
-
-=item B<Comments>
-
-Additional comments may be put into the testing output on their own
-lines.  Comment lines should begin with a '#', Test::Harness will
-ignore them.
-
-  ok 1
-  # Life is good, the sun is shining, RAM is cheap.
-  not ok 2
-  # got 'Bush' expected 'Gore'
-
-=item B<Anything else>
-
-Any other output Test::Harness sees it will silently ignore B<BUT WE
-PLAN TO CHANGE THIS!> If you wish to place additional output in your
-test script, please use a comment.
-
-=back
+C<Test::Harness::runtests(@tests)> runs all the testscripts named
+as arguments and checks standard output for the expected strings
+in TAP format.
 
+The F<prove> utility is a thin wrapper around Test::Harness.
 
 =head2 Taint mode
 
-Test::Harness will honor the C<-T> in the #! line on your test files.  So
-if you begin a test with:
+Test::Harness will honor the C<-T> or C<-t> in the #! line on your
+test files.  So if you begin a test with:
 
     #!perl -T
 
 the test will be run with taint mode on.
 
-
 =head2 Configuration variables.
 
 These variables can be used to configure the behavior of
@@ -236,25 +113,25 @@ Test::Harness.  They are exported on request.
 
 =over 4
 
-=item B<$Test::Harness::verbose>
+=item C<$Test::Harness::Verbose>
 
-The global variable $Test::Harness::verbose is exportable and can be
-used to let runtests() display the standard output of the script
-without altering the behavior otherwise.
+The package variable C<$Test::Harness::Verbose> is exportable and can be
+used to let C<runtests()> display the standard output of the script
+without altering the behavior otherwise.  The F<prove> utility's C<-v>
+flag will set this.
 
-=item B<$Test::Harness::switches>
+=item C<$Test::Harness::switches>
 
-The global variable $Test::Harness::switches is exportable and can be
+The package variable C<$Test::Harness::switches> is exportable and can be
 used to set perl command line options used for running the test
-script(s). The default value is C<-w>.
+script(s). The default value is C<-w>. It overrides C<HARNESS_SWITCHES>.
 
 =back
 
 
 =head2 Failure
 
-It will happen, your tests will fail.  After you mop up your ego, you
-can begin examining the summary report:
+When tests fail, analyze the summary report:
 
   t/base..............ok
   t/nonumbers.........ok
@@ -269,7 +146,7 @@ can begin examining the summary report:
   t/waterloo.t    3   768    20   10  50.00%  1 3 5 7 9 11 13 15 17 19
   Failed 1/5 test scripts, 80.00% okay. 10/44 subtests failed, 77.27% okay.
 
-Everything passed but t/waterloo.t.  It failed 10 of 20 tests and
+Everything passed but F<t/waterloo.t>.  It failed 10 of 20 tests and
 exited with non-zero status indicating something dubious happened.
 
 The columns in the summary report mean:
@@ -286,7 +163,7 @@ If the test exited with non-zero, this is its exit status.
 
 =item B<Wstat>
 
-The wait status of the test I<umm, I need a better explanation here>.
+The wait status of the test.
 
 =item B<Total>
 
@@ -319,18 +196,14 @@ Test::Harness currently only has one function, here it is.
 
   my $allok = runtests(@test_files);
 
-This runs all the given @test_files and divines whether they passed
+This runs all the given I<@test_files> and divines whether they passed
 or failed based on their output to STDOUT (details above).  It prints
 out each individual test which failed along with a summary report and
 a how long it all took.
 
-It returns true if everything was ok.  Otherwise it will die() with
+It returns true if everything was ok.  Otherwise it will C<die()> with
 one of the messages in the DIAGNOSTICS section.
 
-=for _private
-
-This is just _run_all_tests() plus _show_results()
-
 =cut
 
 sub runtests {
@@ -370,7 +243,7 @@ sub _all_ok {
   my @files = _globdir $dir;
 
 Returns all the files in a directory.  This is shorthand for backwards
-compatibility on systems where glob() doesn't work right.
+compatibility on systems where C<glob()> doesn't work right.
 
 =cut
 
@@ -386,9 +259,9 @@ sub _globdir {
 
   my($total, $failed) = _run_all_tests(@test_files);
 
-Runs all the given @test_files (as runtests()) but does it quietly (no
-report).  $total is a hash ref summary of all the tests run.  Its keys
-and values are this:
+Runs all the given C<@test_files> (as C<runtests()>) but does it
+quietly (no report).  $total is a hash ref summary of all the tests
+run.  Its keys and values are this:
 
     bonus           Number of individual todo tests unexpectedly passed
     max             Number of individual tests ran
@@ -402,8 +275,8 @@ and values are this:
     tests           Number of test files originally given
     skipped         Number of test files skipped
 
-If $total->{bad} == 0 and $total->{max} > 0, you've got a successful
-test.
+If C<< $total->{bad} == 0 >> and C<< $total->{max} > 0 >>, you've
+got a successful test.
 
 $failed is a hash ref of all the test scripts which failed.  Each key
 is the name of a test script, each value is another hash representing
@@ -417,16 +290,26 @@ how that script failed.  Its keys are these:
     percent     Percentage of tests which failed
     canon       List of tests which failed (as string).
 
-Needless to say, $failed should be empty if everything passed.
+C<$failed> should be empty if everything passed.
 
 B<NOTE> Currently this function is still noisy.  I'm working on it.
 
 =cut
 
-#'#
+# Turns on autoflush for the handle passed
+sub _autoflush {
+    my $flushy_fh = shift;
+    my $old_fh = select $flushy_fh;
+    $| = 1;
+    select $old_fh;
+}
+
 sub _run_all_tests {
-    my(@tests) = @_;
-    local($|) = 1;
+    my @tests = @_;
+
+    _autoflush(\*STDOUT);
+    _autoflush(\*STDERR);
+
     my(%failedtests);
 
     # Test-wide totals.
@@ -444,21 +327,30 @@ sub _run_all_tests {
                 bench    => 0,
                );
 
-    my @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
-    my $t_start = new Benchmark;
+    my @dir_files;
+    @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
+    my $run_start_time = new Benchmark;
 
     my $width = _leader_width(@tests);
     foreach my $tfile (@tests) {
-
+        $Last_ML_Print = 0;  # so each test prints at least once
         my($leader, $ml) = _mk_leader($tfile, $width);
         local $ML = $ml;
+
         print $leader;
 
         $tot{files}++;
 
         $Strap->{_seen_header} = 0;
+        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 };
+          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} }
@@ -484,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}++;
             }
@@ -510,8 +406,7 @@ sub _run_all_tests {
             # List overruns as failures.
             else {
                 my $details = $results{details};
-                foreach my $overrun ($test{max}+1..@$details)
-                {
+                foreach my $overrun ($test{max}+1..@$details) {
                     next unless ref $details->[$overrun-1];
                     push @{$test{failed}}, $overrun
                 }
@@ -523,8 +418,8 @@ sub _run_all_tests {
                 $failedtests{$tfile}{name} = $tfile;
             }
             elsif($results{seen}) {
-                if (@{$test{failed}}) {
-                    my ($txt, $canon) = canonfailed($test{max},$test{skipped},
+                if (@{$test{failed}} and $test{max}) {
+                    my ($txt, $canon) = _canonfailed($test{max},$test{skipped},
                                                     @{$test{failed}});
                     print "$test{ml}$txt";
                     $failedtests{$tfile} = { canon   => $canon,
@@ -535,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   => '??',
@@ -548,7 +444,8 @@ sub _run_all_tests {
                                            };
                 }
                 $tot{bad}++;
-            } else {
+            }
+            else {
                 print "FAILED before any test output arrived\n";
                 $tot{bad}++;
                 $failedtests{$tfile} = { canon       => '??',
@@ -573,8 +470,8 @@ sub _run_all_tests {
                 @dir_files = @new_dir_files;
             }
         }
-    }
-    $tot{bench} = timediff(new Benchmark, $t_start);
+    } # foreach test
+    $tot{bench} = timediff(new Benchmark, $run_start_time);
 
     $Strap->_restore_PERL5LIB;
 
@@ -585,12 +482,12 @@ sub _run_all_tests {
 
   my($leader, $ml) = _mk_leader($test_file, $width);
 
-Generates the 't/foo........' $leader for the given $test_file as well
+Generates the 't/foo........' leader for the given C<$test_file> as well
 as a similar version which will overwrite the current line (by use of
-\r and such).  $ml may be empty if Test::Harness doesn't think you're
+\r and such).  C<$ml> may be empty if Test::Harness doesn't think you're
 on TTY.
 
-The $width is the width of the "yada/blah.." string.
+The C<$width> is the width of the "yada/blah.." string.
 
 =cut
 
@@ -599,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);
 }
@@ -642,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.",
@@ -675,8 +577,14 @@ sub _show_results {
 }
 
 
-my %Handlers = ();
-$Strap->{callback} = sub {
+my %Handlers = (
+    header => \&header_handler,
+    test => \&test_handler,
+    bailout => \&bailout_handler,
+);
+
+$Strap->{callback} = \&strap_callback;
+sub strap_callback {
     my($self, $line, $type, $totals) = @_;
     print $line if $Verbose;
 
@@ -685,7 +593,7 @@ $Strap->{callback} = sub {
 };
 
 
-$Handlers{header} = sub {
+sub header_handler {
     my($self, $line, $type, $totals) = @_;
 
     warn "Test header seen more than once!\n" if $self->{_seen_header};
@@ -697,7 +605,7 @@ $Handlers{header} = sub {
          $totals->{max}  < $totals->{seen};
 };
 
-$Handlers{test} = sub {
+sub test_handler {
     my($self, $line, $type, $totals) = @_;
 
     my $curr = $totals->{seen};
@@ -706,7 +614,7 @@ $Handlers{test} = sub {
     my $detail = $totals->{details}[-1];
 
     if( $detail->{ok} ) {
-        _print_ml("ok $curr/$max");
+        _print_ml_less("ok $curr/$max");
 
         if( $detail->{type} eq 'skip' ) {
             $totals->{skip_reason} = $detail->{reason}
@@ -729,7 +637,7 @@ $Handlers{test} = sub {
 
 };
 
-$Handlers{bailout} = sub {
+sub bailout_handler {
     my($self, $line, $type, $totals) = @_;
 
     die "FAILED--Further testing stopped" .
@@ -742,6 +650,15 @@ sub _print_ml {
 }
 
 
+# For slow connections, we save lots of bandwidth by printing only once
+# per second.
+sub _print_ml_less {
+    if ( $Last_ML_Print != time ) {
+        _print_ml(@_);
+        $Last_ML_Print = time;
+    }
+}
+
 sub _bonusmsg {
     my($tot) = @_;
 
@@ -778,14 +695,6 @@ sub _dubious_return {
            $wstatus,$wstatus;
     print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
 
-    if (corestatus($wstatus)) { # until we have a wait module
-        if ($Have_Devel_Corestack) {
-            Devel::CoreStack::stack($^X);
-        } else {
-            print "\ttest program seems to have generated a core\n";
-        }
-    }
-
     $tot->{bad}++;
 
     if ($test->{max}) {
@@ -797,7 +706,7 @@ sub _dubious_return {
         else {
             push @{$test->{failed}}, $test->{'next'}..$test->{max};
             $failed = @{$test->{failed}};
-            (my $txt, $canon) = canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
+            (my $txt, $canon) = _canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
             $percent = 100*(scalar @{$test->{failed}})/$test->{max};
             print "DIED. ",$txt;
         }
@@ -864,30 +773,7 @@ sub _create_fmts {
     return($fmt_top, $fmt);
 }
 
-{
-    my $tried_devel_corestack;
-
-    sub corestatus {
-        my($st) = @_;
-
-        my $did_core;
-        eval { # we may not have a WCOREDUMP
-            local $^W = 0;  # *.ph files are often *very* noisy
-            require 'wait.ph';
-            $did_core = WCOREDUMP($st);
-        };
-        if( $@ ) {
-            $did_core = $st & 0200;
-        }
-
-        eval { require Devel::CoreStack; $Have_Devel_Corestack++ } 
-          unless $tried_devel_corestack++;
-
-        return $did_core;
-    }
-}
-
-sub canonfailed ($@) {
+sub _canonfailed ($$@) {
     my($max,$skipped,@failed) = @_;
     my %seen;
     @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
@@ -900,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 = $_;
@@ -912,19 +794,32 @@ sub canonfailed ($@) {
         local $" = ", ";
         push @result, "FAILED tests @canon\n";
         $canon = join ' ', @canon;
-    } else {
+    }
+    else {
         push @result, "FAILED test $last\n";
         $canon = $last;
     }
 
     push @result, "\tFailed $failed/$max tests, ";
-    push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
+    if ($max) {
+       push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
+    }
+    else {
+       push @result, "?% okay";
+    }
     my $ender = 's' x ($skipped > 1);
-    my $good = $max - $failed - $skipped;
-    my $goodper = sprintf("%.2f",100*($good/$max));
-    push @result, " (less $skipped skipped test$ender: $good okay, ".
-                  "$goodper%)"
-         if $skipped;
+    if ($skipped) {
+        my $good = $max - $failed - $skipped;
+       my $skipmsg = " (less $skipped skipped test$ender: $good okay, ";
+       if ($max) {
+           my $goodper = sprintf("%.2f",100*($good/$max));
+           $skipmsg .= "$goodper%)";
+        }
+        else {
+           $skipmsg .= "?%)";
+       }
+       push @result, $skipmsg;
+    }
     push @result, "\n";
     my $txt = join "", @result;
     ($txt, $canon);
@@ -943,10 +838,9 @@ __END__
 
 =head1 EXPORT
 
-C<&runtests> is exported by Test::Harness per default.
-
-C<$verbose> and C<$switches> are exported upon request.
+C<&runtests> is exported by Test::Harness by default.
 
+C<$verbose>, C<$switches> and C<$debug> are exported upon request.
 
 =head1 DIAGNOSTICS
 
@@ -981,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_ACTIVE>
 
-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<HARNESS_VERSION>
+
+This is the version of Test::Harness.
+
+=back
+
+=head1 ENVIRONMENT VARIABLES THAT AFFECT TEST::HARNESS
+
+=over 4
 
 =item C<HARNESS_COLUMNS>
 
@@ -1006,6 +911,13 @@ C<perlcc> before running it.
 B<NOTE> This currently only works when sitting in the perl source
 directory!
 
+=item C<HARNESS_DEBUG>
+
+If true, Test::Harness will print debugging information about itself as
+it runs the tests.  This is different from C<HARNESS_VERBOSE>, which prints
+the output from the test being run.  Setting C<$Test::Harness::Debug> will
+override this, or you can use the C<-d> switch in the F<prove> utility.
+
 =item C<HARNESS_FILELEAK_IN_DIR>
 
 When set to the name of a directory, harness will check after each
@@ -1029,6 +941,14 @@ output more frequent progress messages using carriage returns.  Some
 consoles may not handle carriage returns properly (which results in a
 somewhat messy output).
 
+=item C<HARNESS_PERL>
+
+Usually your tests will be run by C<$^X>, the currently-executing Perl.
+However, you may want to have it run by a different executable, such as
+a threading perl, or a different version.
+
+If you're using the F<prove> utility, you can use the C<--perl> switch.
+
 =item C<HARNESS_PERL_SWITCHES>
 
 Its value will be prepended to the switches used to invoke perl on
@@ -1038,7 +958,8 @@ run all tests with all warnings enabled.
 =item C<HARNESS_VERBOSE>
 
 If true, Test::Harness will output the verbose results of running
-its tests.  Setting $Test::Harness::verbose will override this.
+its tests.  Setting C<$Test::Harness::verbose> will override this,
+or you can use the C<-v> switch in the F<prove> utility.
 
 =back
 
@@ -1059,28 +980,11 @@ Here's how Test::Harness tests itself
 
 =head1 SEE ALSO
 
+The included F<prove> utility for running test scripts from the command line,
 L<Test> and L<Test::Simple> for writing test scripts, L<Benchmark> for
-the underlying timing routines, L<Devel::CoreStack> to generate core
-dumps from failed tests and L<Devel::Cover> for test coverage
+the underlying timing routines, and L<Devel::Cover> for test coverage
 analysis.
 
-=head1 AUTHORS
-
-Either Tim Bunce or Andreas Koenig, we don't know. What we know for
-sure is, that it was inspired by Larry Wall's TEST script that came
-with perl distributions for ages. Numerous anonymous contributors
-exist.  Andreas Koenig held the torch for many years.
-
-Current maintainer is Michael G Schwern E<lt>schwern@pobox.comE<gt>
-
-=head1 LICENSE
-
-This program is free software; you can redistribute it and/or 
-modify it under the same terms as Perl itself.
-
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
-
 =head1 TODO
 
 Provide a way of running tests quietly (ie. no printing) for automated
@@ -1088,6 +992,8 @@ validation of tests.  This will probably take the form of a version
 of runtests() which rather than printing its output returns raw data
 on the state of the tests.  (Partially done in Test::Harness::Straps)
 
+Document the format.
+
 Fix HARNESS_COMPILE_TEST without breaking its core usage.
 
 Figure a way to report test names in the failure summary.
@@ -1095,14 +1001,34 @@ Figure a way to report test names in the failure summary.
 Rework the test summary so long test names are not truncated as badly.
 (Partially done with new skip test styles)
 
-Deal with VMS's "not \nok 4\n" mistake.
-
 Add option for coverage analysis.
 
-=for _private
+Trap STDERR.
+
+Implement Straps total_results()
+
+Remember exit code
+
+Completely redo the print summary code.
+
+Implement Straps callbacks.  (experimentally implemented)
+
+Straps->analyze_file() not taint clean, don't know if it can be
+
+Fix that damned VMS nit.
+
+HARNESS_TODOFAIL to display TODO failures
+
+Add a test for verbose.
+
+Change internal list of test results to a hash.
+
+Fix stats display when there's an overrun.
+
+Fix so perls with spaces in the filename work.
+
 Keeping whittling away at _run_all_tests()
 
-=for _private
 Clean up how the summary is printed.  Get rid of those damned formats.
 
 =head1 BUGS
@@ -1110,4 +1036,29 @@ Clean up how the summary is printed.  Get rid of those damned formats.
 HARNESS_COMPILE_TEST currently assumes it's run from the Perl source
 directory.
 
+Please use the CPAN bug ticketing system at L<http://rt.cpan.org/>.
+You can also mail bugs, fixes and enhancements to 
+C<< <bug-test-harness >> at C<< rt.cpan.org> >>.
+
+=head1 AUTHORS
+
+Either Tim Bunce or Andreas Koenig, we don't know. What we know for
+sure is, that it was inspired by Larry Wall's TEST script that came
+with perl distributions for ages. Numerous anonymous contributors
+exist.  Andreas Koenig held the torch for many years, and then
+Michael G Schwern.
+
+Current maintainer is Andy Lester C<< <andy at petdance.com> >>.
+
+=head1 COPYRIGHT
+
+Copyright 2002-2005
+by Michael G Schwern C<< <schwern at pobox.com> >>,
+Andy Lester C<< <andy at petdance.com> >>.
+
+This program is free software; you can redistribute it and/or 
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>.
+
 =cut