Implement NetBSD patch-aa.

[p5sagit/p5-mst-13.2.git] / vms / test.com

diff --git a/vms/test.com b/vms/test.com
index 62532f5..8c4d840 100644 (file)
--- a/vms/test.com
+++ b/vms/test.com
@@ -2,7 +2,7 @@ $!  Test.Com - DCL driver for perl5 regression tests
 $!
 $!  Version 1.1   4-Dec-1995
 $!  Charles Bailey  bailey@newman.upenn.edu
-$
+$!
 $!  A little basic setup
 $   On Error Then Goto wrapup
 $   olddef = F$Environment("Default")
@@ -20,7 +20,7 @@ $           Exit 44
 $       EndIf
 $   EndIf
 $   Set Message /NoFacility/NoSeverity/NoIdentification/NoText
-$
+$!
 $   exe = ".Exe"
 $   If p1.nes."" Then exe = p1
 $   If F$Extract(0,1,exe) .nes. "."
@@ -48,85 +48,22 @@ $!  Pick up a copy of vmspipe.com to use for the tests
 $   If F$Search("VMSPIPE.COM").nes."" then Delete/Log/Noconfirm VMSPIPE.COM;*
 $   Copy/Log/NoConfirm [-]VMSPIPE.COM []
 $!
-$!  Make the environment look a little friendlier to tests which assume Unix
-$   cat == "Type"
-$   Macro/NoDebug/NoList/Object=Echo.Obj Sys$Input
-               .title echo
-               .psect data,wrt,noexe
-       dsc:
-               .word 0
-               .byte 14 ; DSC$K_DTYPE_T
-               .byte 2  ; DSC$K_CLASS_D
-               .long 0
-               .psect code,nowrt,exe
-               .entry  echo,^m<r2,r3>
-               movab   dsc,r2
-               pushab  (r2)
-               calls   #1,G^LIB$GET_FOREIGN
-               movl    4(r2),r3
-               movzwl  (r2),r0
-               addl2   4(r2),r0
-               cmpl    r3,r0
-               bgtru   sym.3
-               nop     
-       sym.1:
-               movb    (r3),r0
-               cmpb    r0,#65
-               blss    sym.2
-               cmpb    r0,#90
-               bgtr    sym.2
-               cvtbl   r0,r0
-               addl2   #32,r0
-               cvtlb   r0,(r3)
-       sym.2:
-               incl    r3
-               movzwl  (r2),r0
-               addl2   4(r2),r0
-               cmpl    r3,r0
-               blequ   sym.1
-       sym.3:
-               pushab  (r2)
-               calls   #1,G^LIB$PUT_OUTPUT
-               movl    #1,r0
-               ret     
-               .end echo
-$   If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;*
-$   Link/NoMap/NoTrace/Exe=Echo.Exe Echo.Obj;
-$   Delete/Log/NoConfirm Echo.Obj;*
-$   echo == "$" + F$Parse("Echo.Exe")
-$
 $!  And do it
 $   Show Process/Accounting
 $   testdir = "Directory/NoHead/NoTrail/Column=1"
 $   PerlShr_filespec = f$parse("Sys$Disk:[-]''dbg'PerlShr''exe'")
 $   Define 'dbg'Perlshr 'PerlShr_filespec'
+$   if f$mode() .nes. "INTERACTIVE" then Define PERL_SKIP_TTY_TEST 1
 $   MCR Sys$Disk:[]Perl. "-I[-.lib]" - "''p3'" "''p4'" "''p5'" "''p6'"
 $   Deck/Dollar=$$END-OF-TEST$$
-# $RCSfile: test.com,v $$Revision: 1.1 $$Date: 2001/11/13 00:26:19 $
-# Modified for VMS 30-Sep-1994  Charles Bailey  bailey@newman.upenn.edu
 #
-# This is written in a peculiar style, since we're trying to avoid
-# most of the constructs we'll be testing for.
+# The bulk of the below code is scheduled for deletion.  test.com
+# will shortly use t/TEST.
+#
 
-# skip those tests we know will fail entirely or cause perl to hang bacause
-# of Unixisms in the tests.  (The Perl operators being tested may work fine,
-# but the tests may use other operators which don't.)
 use Config;
 use File::Spec;
 
-@compexcl=('cpp.t');
-@libexcl=('io_pipe.t', 'io_poll.t', 'io_sel.t',
-          'io_sock.t', 'io_unix.t');
-
-# io_xs.t tests the new_tmpfile routine, which doesn't work with the
-# VAXCRTL, since the file can't be stat()d, an Perl's do_open()
-# insists on stat()ing a file descriptor before it'll use it.
-push(@libexcl,'io_xs.t') if $Config{'vms_cc_type'} ne 'decc';
-
-@opexcl=('die_exit.t','exec.t','groups.t','magic.t','stat.t');
-@exclist=(@compexcl,@ioexcl,@libexcl,@opexcl);
-foreach $file (@exclist) { $skip{$file}++; }
-
 $| = 1;
 
 # Let tests know they're running in the perl core.  Useful for modules
@@ -147,19 +84,13 @@ if ($ARGV[0] eq '') {
       $_ = File::Spec->abs2rel($_);
       s/\[([a-z]+)/[.$1/;      # hmm, abs2rel doesn't do subdirs of the cwd
       ($fname = $_) =~ s/.*\]//;
-      if ($skip{"\L$fname"}) { push(@skipped,$_); }
-      else { push(@ARGV,$_); }
+      push(@ARGV,$_);
     }
 }
 
-if (@skipped) {
-  print "The following tests were skipped because they rely extensively on\n";
-  print " Unixisms not compatible with the current version of perl for VMS:\n";
-  print "\t",join("\n\t",@skipped),"\n\n";
-}
-
 $bad = 0;
 $good = 0;
+$extra_skip = 0;
 $total = @ARGV;
 while ($test = shift) {
     if ($test =~ /^$/) {
@@ -244,6 +175,7 @@ while ($test = shift) {
        } else {
            print "${te}skipping test on this platform\n";
            $files -= 1;
+           $extra_skip = $extra_skip + 1;
        }
     } else {
        $next += 1;
@@ -263,11 +195,21 @@ if ($bad == 0) {
        die "FAILED--no tests were run for some reason.\n";
     }
 } else {
-    $pct = sprintf("%.2f", $good / $total * 100);
+    # $pct = sprintf("%.2f", $good / $total * 100);
+    $gtotal = $total - $extra_skip;
+    if ($gtotal <= 0) { $gtotal = $total; }
+    $pct = sprintf("%.2f", $good / $gtotal * 100);
     if ($bad == 1) {
        warn "Failed 1 test, $pct% okay.\n";
-    } else {
-       warn "Failed $bad/$total tests, $pct% okay.\n";
+   } else {
+         if ($extra_skip > 0) {
+            warn "Total tests: $total, Passed $good, Skipped $extra_skip.\n";
+            warn "Failed $bad/$gtotal tests, $pct% okay.\n";
+         }
+         else {
+            warn "Total tests: $total, Passed $good.\n";
+            warn "Failed $bad/$gtotal tests, $pct% okay.\n";
+         }
     }
 }
 ($user,$sys,$cuser,$csys) = times;