home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl501m.zip / lib / Test / Harness.pm
Text File  |  1994-10-12  |  2KB  |  81 lines
  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;
  81.