lib/Test/Harness.pm

   1 package Test::Harness;
   2
   3 use Exporter;
   4 use Benchmark;
   5 @ISA=(Exporter);
   6 @EXPORT= qw(&runtests &test_lib);
   7 @EXPORT_OK= qw($verbose $switches);
   8
   9 $verbose = 0;
  10 $switches = "-w";
  11
  12 sub runtests {
  13     my(@tests) = @_;
  14     local($|) = 1;
  15     my($test,$te,$ok,$next,$max,$totmax, $files,$pct);
  16     my $bad = 0;
  17     my $good = 0;
  18     my $total = @tests;
  19     local($ENV{'PERL5LIB'}) = join(':', @INC); # pass -I flags to children
  20
  21     my $t_start = new Benchmark;
  22     while ($test = shift(@tests)) {
  23       $te = $test;
  24       chop($te);
  25       print "$te" . '.' x (20 - length($te));
  26       my $fh = "RESULTS";
  27       open($fh,"$^X $switches $test|") || (print "can't run. $!\n");
  28       $ok = 0;
  29       $next = 0;
  30       while (<$fh>) {
  31           if( $verbose ){
  32                   print $_;
  33           }
  34           unless (/^#/) {
  35               if (/^1\.\.([0-9]+)/) {
  36                   $max = $1;
  37                   $totmax += $max;
  38                   $files += 1;
  39                   $next = 1;
  40                   $ok = 1;
  41               } else {
  42                   $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
  43                   if (/^ok (.*)/ && $1 == $next) {
  44                       $next = $next + 1;
  45                   }
  46               }
  47           }
  48       }
  49       close($fh); # must close to reap child resource values
  50       $next -= 1;
  51       if ($ok && $next == $max) {
  52           print "ok\n";
  53           $good += 1;
  54       } else {
  55           $next += 1;
  56           print "FAILED on test $next\n";
  57           $bad += 1;
  58           $_ = $test;
  59       }
  60     }
  61     my $t_total = timediff(new Benchmark, $t_start);
  62
  63     if ($bad == 0) {
  64       if ($ok) {
  65           print "All tests successful.\n";
  66       } else {
  67           die "FAILED--no tests were run for some reason.\n";
  68       }
  69     } else {
  70       $pct = sprintf("%.2f", $good / $total * 100);
  71       if ($bad == 1) {
  72           warn "Failed 1 test, $pct% okay.\n";
  73       } else {
  74           die "Failed $bad/$total tests, $pct% okay.\n";
  75       }
  76     }
  77     printf("Files=%d,  Tests=%d, %s\n", $files,$totmax, timestr($t_total, 'nop'));
  78 }
  79
  80 1;