t/TEST

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