home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / ntperlb / t / testnt.cmd < prev   
Encoding:
Text File  |  1995-05-19  |  2.2 KB  |  111 lines
  1. @rem = '
  2. @rem -*- Perl -*-
  3. @echo off
  4. ..\perl %0.cmd %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. ';
  7. # $RCSfile: TEST,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:59:30 $
  8.  
  9. # This is written in a peculiar style, since we're trying to avoid
  10. # most of the constructs we'll be testing for.
  11.  
  12. $| = 1;
  13.  
  14. if ($ARGV[0] eq '-v') {
  15.     $verbose = 1;
  16.     shift;
  17. }
  18.  
  19. chdir 't' if -f 't/nttest.cmd';
  20.  
  21. chop ($wd = `cd`);
  22. $wd =~ tr/A-Z/a-z/;
  23. $exedir = $wd;
  24. $exedir =~ s,[\\/]t$,,;
  25.  
  26. #
  27. # put our just-made version of perl at the head of the path
  28. #
  29.  
  30. $ENV{'Path'} = "$exedir;$ENV{'Path'}";
  31. $ENV{'PERLLIB'} = "$execdir\\lib";
  32.  
  33. if ($ARGV[0] eq '') {
  34.     @ARGV = <base\\*.nt comp\\*.nt cmd\\*.nt io\\*.nt op\\*.nt lib\\*.nt nt\\*.nt>;
  35. }
  36.  
  37. $bad = 0;
  38. while ($test = shift) {     
  39.     if ($test =~ /^$/) {
  40.     next;
  41.     }
  42.     $te = $test;
  43.     substr ($te, -2) = '';
  44.     print "$te" . '.' x (15 - length($te));
  45.     open(script,"$test") || die "Can't run $test.\n";
  46.     $_ = <script>;
  47.     close(script);
  48.     if (/#!..perl(.*)/) {
  49.        $switch = $1;
  50.     } else {
  51.     $switch = '';
  52.     }
  53.     open(results,"perl$switch $test|") || (print "can't run.\n");
  54.  
  55.     $ok = 0;
  56.     $next = 0;
  57.     while (<results>) {
  58.     if ($verbose) {
  59.         print $_;
  60.     }
  61.     unless (/^#/) {
  62.         if (/^1\.\.([0-9]+)/) {
  63.         $max = $1;
  64.         $totmax += $max;
  65.         $files += 1;
  66.         $next = 1;
  67.         $ok = 1;
  68.         } else {
  69.         $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
  70.         if (/^ok (.*)/ && $1 == $next) {
  71.             $next = $next + 1;
  72.         } else {
  73.             $ok = 0;
  74.         }
  75.         }
  76.     }
  77.     }
  78.     $next = $next - 1;
  79.     if ($ok && $next == $max) {
  80.     print "ok\n";
  81.     } else {
  82.     $next += 1;
  83.     print "FAILED on test $next\n";
  84.     $bad = $bad + 1;
  85.     $_ = $test;
  86.     if (/^base/) {
  87.         die "Failed a basic test--cannot continue.\n";
  88.     }
  89.     }
  90. }
  91.  
  92. if ($bad == 0) {
  93.     if ($ok) {
  94.     print "All tests successful.\n";
  95.     } else {
  96.     die "FAILED--no tests were run for some reason.\n";
  97.     }
  98. } else {
  99.     if ($bad == 1) {
  100.     die "Failed 1 test.\n";
  101.     } else {
  102.     die "Failed $bad tests.\n";
  103.     }
  104. }
  105. #($user,$sys,$cuser,$csys) = times;
  106. #print sprintf("u=%g  s=%g  cu=%g  cs=%g  files=%d  tests=%d\n",
  107. #          $user,$sys,$cuser,$csys,$files,$totmax);
  108.  
  109. __END__
  110. :endofperl
  111.