t/TEST

   1 #!./perl
   2
   3 # $Header: TEST,v 2.0 88/06/05 00:11:47 root Exp $
   4
   5 # This is written in a peculiar style, since we're trying to avoid
   6 # most of the constructs we'll be testing for.
   7
   8 if ($ARGV[0] eq '-v') {
   9     $verbose = 1;
  10     shift;
  11 }
  12
  13 chdir 't' if -f 't/TEST';
  14
  15 if ($ARGV[0] eq '') {
  16     @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.*`);
  17 }
  18
  19 open(config,"../config.sh");
  20 while (<config>) {
  21     if (/sharpbang='(.*)'/) {
  22         $sharpbang = ($1 eq '#!');
  23         last;
  24     }
  25 }
  26 $bad = 0;
  27 while ($test = shift) {
  28     if ($test =~ /\.orig$/) {
  29         next;
  30     }
  31     print "$test...";
  32     if ($sharpbang) {
  33         open(results,"./$test|") || (print "can't run.\n");
  34     } else {
  35         open(script,"$test") || die "Can't run $test.\n";
  36         $_ = <script>;
  37         close(script);
  38         if (/#!..perl(.*)/) {
  39             $switch = $1;
  40         } else {
  41             $switch = '';
  42         }
  43         open(results,"./perl$switch $test|") || (print "can't run.\n");
  44     }
  45     $ok = 0;
  46     $next = 0;
  47     while (<results>) {
  48         if ($verbose) {
  49             print $_;
  50         }
  51         unless (/^#/) {
  52             if (/^1\.\.([0-9]+)/) {
  53                 $max = $1;
  54                 $next = 1;
  55                 $ok = 1;
  56             } else {
  57                 if (/^ok (.*)/ && $1 == $next) {
  58                     $next = $next + 1;
  59                 } else {
  60                     $ok = 0;
  61                 }
  62             }
  63         }
  64     }
  65     $next = $next - 1;
  66     if ($ok && $next == $max) {
  67         print "ok\n";
  68     } else {
  69         $next += 1;
  70         print "FAILED on test $next\n";
  71         $bad = $bad + 1;
  72         $_ = $test;
  73         if (/^base/) {
  74             die "Failed a basic test--cannot continue.\n";
  75         }
  76     }
  77 }
  78
  79 if ($bad == 0) {
  80     if ($ok) {
  81         print "All tests successful.\n";
  82     } else {
  83         die "FAILED--no tests were run for some reason.\n";
  84     }
  85 } else {
  86     if ($bad == 1) {
  87         die "Failed 1 test.\n";
  88     } else {
  89         die "Failed $bad tests.\n";
  90     }
  91 }
  92 ($user,$sys,$cuser,$csys) = times;
  93 print sprintf("u=%g  s=%g  cu=%g  cs=%g\n",$user,$sys,$cuser,$csys);