This is my patch patch.1n for perl5.001.

[p5sagit/p5-mst-13.2.git] / lib / Test / Harness.pm

package Test::Harness;

use Exporter;
use Benchmark;
@ISA=(Exporter);
@EXPORT= qw(&runtests &test_lib);
@EXPORT_OK= qw($verbose $switches);

$verbose = 0;
$switches = "-w";

sub runtests {
    my(@tests) = @_;
    local($|) = 1;
    my($test,$te,$ok,$next,$max,$totmax, $files,$pct);
    my $bad = 0;
    my $good = 0;
    my $total = @tests;
    local($ENV{'PERL5LIB'}) = join(':', @INC); # pass -I flags to children

    my $t_start = new Benchmark;
    while ($test = shift(@tests)) {
      $te = $test;
      chop($te);
      print "$te" . '.' x (20 - length($te));
      my $fh = "RESULTS";
      open($fh,"$^X $switches $test|") || (print "can't run. $!\n");
      $ok = 0;
      $next = 0;
      while (<$fh>) {
	  if( $verbose ){
		  print $_;
	  }
          unless (/^#/) {
              if (/^1\.\.([0-9]+)/) {
                  $max = $1;
                  $totmax += $max;
                  $files += 1;
                  $next = 1;
                  $ok = 1;
              } else {
		  $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
                  if (/^ok (.*)/ && $1 == $next) {
                      $next = $next + 1;
                  }
              }
          }
      }
      close($fh); # must close to reap child resource values
      $next -= 1;
      if ($ok && $next == $max) {
          print "ok\n";
          $good += 1;
      } else {
          $next += 1;
          print "FAILED on test $next\n";
          $bad += 1;
          $_ = $test;
      }
    }
    my $t_total = timediff(new Benchmark, $t_start);

    if ($bad == 0) {
      if ($ok) {
          print "All tests successful.\n";
      } else {
          die "FAILED--no tests were run for some reason.\n";
      }
    } else {
      $pct = sprintf("%.2f", $good / $total * 100);
      if ($bad == 1) {
          warn "Failed 1 test, $pct% okay.\n";
      } else {
          die "Failed $bad/$total tests, $pct% okay.\n";
      }
    }
    printf("Files=%d,  Tests=%d, %s\n", $files,$totmax, timestr($t_total, 'nop'));
}

1;