home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / bin / test.bat < prev    next >
Encoding:
DOS Batch File  |  1997-08-10  |  3.3 KB  |  144 lines
  1. @rem = '
  2. @echo off
  3. if exist perl.exe goto perlhere
  4. echo Cannot run without perl.exe in current directory!!    Did you build it?
  5. pause
  6. goto endofperl
  7. :perlhere
  8. if exist perlglob.exe goto perlglobhere
  9. echo Cannot run without perlglob.exe in current directory!!    Did you build it?
  10. pause
  11. goto endofperl
  12. :perlglobhere
  13. perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
  14. goto endofperl
  15. @rem ';
  16.  
  17. #Portions (C) 1995 Microsoft Corporation. All rights reserved. 
  18. #        Developed by hip communications inc., http://info.hip.com/info/
  19.  
  20.  
  21. # This is written in a peculiar style, since we're trying to avoid
  22. # most of the constructs we'll be testing for.
  23.  
  24. $| = 1;
  25.  
  26. if ($ARGV[0] eq '-v') {
  27.     $verbose = 1;
  28.     shift;
  29. }
  30.  
  31.  
  32. # WYT 1995-05-02
  33. chdir 't' if -f 't/TESTNT';
  34.  
  35.  
  36. if ($ARGV[0] eq '') {
  37. #    @ARGV = split(/[ \n]/,
  38. #      `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t lib/*.t`);
  39. #      `ls base/*.t comp/*.t cmd/*.t io/*.t op/*.t lib/*.t`);
  40.  
  41. # WYT 1995-05-02 wildcard expansion,
  42. #    `perl -e "print( join( ' ', \@ARGV ) )" base/*.t comp/*.t cmd/*.t io/*.t op/*.t lib/*.t nt/*.t`);
  43.  
  44. # WYT 1995-06-01 removed all dependency on perlglob
  45. # WYT 1995-11-28 hacked up to cope with braindead Win95 console.
  46.     push( @ARGV, `dir/s/b base` );
  47.     push( @ARGV, `dir/s/b comp` );
  48.     push( @ARGV, `dir/s/b cmd` );
  49.     push( @ARGV, `dir/s/b io` );
  50.     push( @ARGV, `dir/s/b op` );
  51.     push( @ARGV, `dir/s/b lib` );
  52.     push( @ARGV, `dir/s/b nt` );
  53.  
  54.     grep( chomp, @ARGV );
  55.     @ARGV = grep( /\.t$/, @ARGV );
  56.     grep( s/.*t\\//, @ARGV );
  57. }
  58.  
  59. $sharpbang = 0;
  60.  
  61. $bad = 0;
  62. $good = 0;
  63. $total = @ARGV;
  64. while ($test = shift) {
  65.     if ($test =~ /^$/) {
  66.     next;
  67.     }
  68.     $te = $test;
  69. # chop off 't' extension
  70.     chop($te);
  71.     print "$te" . '.' x (15 - length($te));
  72.     if ($sharpbang) {
  73.     open(results,"./$test |") || (print "can't run.\n");
  74.     } else {
  75.         $switch = '';
  76. #    open(results,"./perl$switch $test |") || (print "can't run.\n");
  77.     open(results,"perl$switch $test |") || (print "can't run.\n");
  78.     }
  79.     $ok = 0;
  80.     $next = 0;
  81.     while (<results>) {
  82.     if ($verbose) {
  83.         print $_;
  84.     }
  85.         unless (/^#/||/^$/) {
  86.         if (/^1\.\.([0-9]+)/) {
  87.         $max = $1;
  88.         $totmax += $max;
  89.         $files += 1;
  90.         $next = 1;
  91.         $ok = 1;
  92.         } else {
  93.         $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
  94.         if (/^ok (.*)/ && $1 == $next) {
  95.             $next = $next + 1;
  96.         } else {
  97.             $ok = 0;
  98.         }
  99.         }
  100.     }
  101.     }
  102.     $next = $next - 1;
  103.     if ($ok && $next == $max) {
  104.     print "ok\n";
  105.     $good = $good + 1;
  106.     } else {
  107.     $next += 1;
  108.     print "FAILED on test $next\n";
  109.     $bad = $bad + 1;
  110.     $_ = $test;
  111.     if (/^base/) {
  112.         die "Failed a basic test--cannot continue.\n";
  113.     }
  114.     }
  115. }
  116.  
  117. if ($bad == 0) {
  118.     if ($ok) {
  119.     print "All tests successful.\n";
  120.     } else {
  121.     die "FAILED--no tests were run for some reason.\n";
  122.     }
  123. } else {
  124.     $pct = sprintf("%.2f", $good / $total * 100);
  125.     if ($bad == 1) {
  126.     warn "Failed 1 test, $pct% okay.\n";
  127.     } else {
  128.     die "Failed $bad/$total tests, $pct% okay.\n";
  129.     }
  130. }
  131.  
  132.  
  133. # WYT 1995-05-03 times not implemented.
  134. #($user,$sys,$cuser,$csys) = times;
  135. #print sprintf("u=%g  s=%g  cu=%g  cs=%g  files=%d  tests=%d\n",
  136. #    $user,$sys,$cuser,$csys,$files,$totmax);
  137.  
  138. #`del /f Cmd_while.tmp Comp.try null 2>NULL`;
  139.  
  140. unlink 'Cmd_while.tmp', 'Comp.try', 'null';
  141.  
  142. __END__
  143. :endofperl
  144.