win32/bin/test.bat

   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