t/TEST

   1 #!./perl
   2
   3 # $Header: TEST,v 1.0.1.1 88/01/24 03:55:39 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 if ($ARGV[0] eq '') {
  14     @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.*`);
  15 }
  16
  17 open(config,"../config.sh");
  18 while (<config>) {
  19     if (/sharpbang='(.*)'/) {
  20         $sharpbang = ($1 eq '#!');
  21         last;
  22     }
  23 }
  24 $bad = 0;
  25 while ($test = shift) {
  26     print "$test...";
  27     if ($sharpbang) {
  28         open(results,"$test|") || (print "can't run.\n");
  29     } else {
  30         open(script,"$test") || die "Can't run $test";
  31         $_ = <script>;
  32         close(script);
  33         if (/#!..perl(.*)/) {
  34             $switch = $1;
  35         } else {
  36             $switch = '';
  37         }
  38         open(results,"./perl$switch $test|") || (print "can't run.\n");
  39     }
  40     $ok = 0;
  41     while (<results>) {
  42         if ($verbose) {
  43             print $_;
  44         }
  45         unless (/^#/) {
  46             if (/^1\.\.([0-9]+)/) {
  47                 $max = $1;
  48                 $next = 1;
  49                 $ok = 1;
  50             } else {
  51                 if (/^ok (.*)/ && $1 == $next) {
  52                     $next = $next + 1;
  53                 } else {
  54                     $ok = 0;
  55                 }
  56             }
  57         }
  58     }
  59     $next = $next - 1;
  60     if ($ok && $next == $max) {
  61         print "ok\n";
  62     } else {
  63         $next += 1;
  64         print "FAILED on test $next\n";
  65         $bad = $bad + 1;
  66         $_ = $test;
  67         if (/^base/) {
  68             die "Failed a basic test--cannot continue.";
  69         }
  70     }
  71 }
  72
  73 if ($bad == 0) {
  74     if ($ok) {
  75         print "All tests successful.\n";
  76     } else {
  77         die "FAILED--no tests were run for some reason.";
  78     }
  79 } else {
  80     if ($bad == 1) {
  81         die "Failed 1 test.";
  82     } else {
  83         die "Failed $bad tests.";
  84     }
  85 }
  86 ($user,$sys,$cuser,$csys) = times;
  87 print sprintf("u=%g  s=%g  cu=%g  cs=%g\n",$user,$sys,$cuser,$csys);