diff options
Diffstat (limited to 'win32/TEST')
| -rw-r--r-- | win32/TEST | 149 |
1 files changed, 0 insertions, 149 deletions
diff --git a/win32/TEST b/win32/TEST deleted file mode 100644 index 1bda4ef793..0000000000 --- a/win32/TEST +++ /dev/null @@ -1,149 +0,0 @@ -#!./perl - -# Last change: Fri Jan 10 09:57:03 WET 1997 - -# This is written in a peculiar style, since we're trying to avoid -# most of the constructs we'll be testing for. - -$| = 1; - -if ($ARGV[0] eq '-v') { - $verbose = 1; - shift; -} - -chdir 't' if -f 't/TEST'; - -die "You need to run \"make test\" first to set things up.\n" - unless -e 'perl' or -e 'perl.exe'; - -$ENV{EMXSHELL} = 'sh'; # For OS/2 - -if ($ARGV[0] eq '') { - push( @ARGV, `dir/s/b base` ); - push( @ARGV, `dir/s/b comp` ); - push( @ARGV, `dir/s/b cmd` ); - push( @ARGV, `dir/s/b io` ); - push( @ARGV, `dir/s/b op` ); - push( @ARGV, `dir/s/b pragma` ); - push( @ARGV, `dir/s/b lib` ); - - grep( chomp, @ARGV ); - @ARGV = grep( /\.t$/, @ARGV ); - grep( s/.*t\\//, @ARGV ); -# @ARGV = split(/[ \n]/, -# `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`); -} else { - -@ARGV = map(glob($_),@ARGV); - -} - -if ($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'qnx' || 1) { - $sharpbang = 0; -} -else { - open(CONFIG, "../config.sh"); - while (<CONFIG>) { - if (/sharpbang='(.*)'/) { - $sharpbang = ($1 eq '#!'); - last; - } - } - close(CONFIG); -} - -$bad = 0; -$good = 0; -$total = @ARGV; -while ($test = shift) { - if ($test =~ /^$/) { - next; - } - $te = $test; - chop($te); - print "$te" . '.' x (18 - length($te)); - if ($sharpbang) { - open(results,"./$test |") || (print "can't run.\n"); - } else { - open(script,"$test") || die "Can't run $test.\n"; - $_ = <script>; - close(script); - if (/#!..perl(.*)/) { - $switch = $1; - if ($^O eq 'VMS') { - # Must protect uppercase switches with "" on command line - $switch =~ s/-([A-Z]\S*)/"-$1"/g; - } - } else { - $switch = ''; - } - open(results,"perl$switch $test |") || (print "can't run.\n"); - } - $ok = 0; - $next = 0; - while (<results>) { - if (/^$/) { next;}; - if ($verbose) { - print $_; - } - unless (/^#/) { - if (/^1\.\.([0-9]+)/) { - $max = $1; - $totmax += $max; - $files += 1; - $next = 1; - $ok = 1; - } else { - $next = $1, $ok = 0, last if /^not ok ([0-9]*)/; - if (/^ok (.*)/ && $1 == $next) { - $next = $next + 1; - } else { - $ok = 0; - } - } - } - } - $next = $next - 1; - if ($ok && $next == $max) { - if ($max) { - print "ok\n"; - $good = $good + 1; - } else { - print "skipping test on this platform\n"; - $files -= 1; - } - } else { - $next += 1; - print "FAILED on test $next\n"; - $bad = $bad + 1; - $_ = $test; - if (/^base/) { - die "Failed a basic test--cannot continue.\n"; - } - } -} - -if ($bad == 0) { - if ($ok) { - print "All tests successful.\n"; - } else { - die "FAILED--no tests were run for some reason.\n"; - } -} else { - $pct = sprintf("%.2f", $good / $total * 100); - if ($bad == 1) { - warn "Failed 1 test script out of $total, $pct% okay.\n"; - } else { - warn "Failed $bad test scripts out of $total, $pct% okay.\n"; - } - warn <<'SHRDLU'; - ### Since not all tests were successful, you may want to run some - ### of them individually and examine any diagnostic messages they - ### produce. See the INSTALL document's section on "make test". -SHRDLU -} -($user,$sys,$cuser,$csys) = times; -print sprintf("u=%g s=%g cu=%g cs=%g scripts=%d tests=%d\n", - $user,$sys,$cuser,$csys,$files,$totmax); -exit $bad != 0; |