vms/test.com

   1 $!  Test.Com - DCL wrapper for perl5 regression test driver
   2 $!
   3 $!  Version 2.0  25-April-2002   Craig Berry  craigberry@mac.com
   4 $!                               (and many other hands in the last 7+ years)
   5 $!  The most significant difference is that we now run the external t/TEST
   6 $!  rather than keeping a separately maintained test driver embedded here.
   7 $!
   8 $!  Version 1.1   4-Dec-1995
   9 $!  Charles Bailey  bailey@newman.upenn.edu
  10 $!
  11 $!  Set up error handler and save things we'll restore later.
  12 $   On Control_Y Then Goto Control_Y_exit
  13 $   On Error Then Goto wrapup
  14 $   olddef = F$Environment("Default")
  15 $   oldmsg = F$Environment("Message")
  16 $   oldpriv = F$SetPrv("NOALL")         ! downgrade privs for safety
  17 $   discard = F$SetPrv("NETMBX,TMPMBX") ! only need these to run tests
  18 $!
  19 $! Process arguments.  P1 is the file extension of the Perl images.
  20 $! P2, when not empty, indicates that we are testing a version of Perl built
  21 $! for the VMS debugger.  The other arguments are passed directly to t/TEST.
  22 $!
  23 $   exe = ".Exe"
  24 $   If p1.nes."" Then exe = p1
  25 $   If F$Extract(0,1,exe) .nes. "."
  26 $   Then
  27 $     Write Sys$Error ""
  28 $     Write Sys$Error "The first parameter passed to Test.Com must be the file type used for the"
  29 $     Write Sys$Error "images produced when you built Perl (i.e. "".Exe"", unless you edited"
  30 $     Write Sys$Error "Descrip.MMS or used the AXE=1 macro in the MM[SK] command line."
  31 $     Write Sys$Error ""
  32 $     $status = 44
  33 $     goto wrapup
  34 $   EndIf
  35 $!
  36 $!  "debug" perl if second parameter is nonblank
  37 $!
  38 $   dbg = ""
  39 $   ndbg = ""
  40 $   if p2.nes."" then dbg  = "dbg"
  41 $   if p2.nes."" then ndbg = "ndbg"
  42 $!
  43 $! Run using "TEST." unless something else (e.g. "harness.") was specified.
  44 $  If F$Type(PERL_TEST_DRIVER) .eqs. "" Then PERL_TEST_DRIVER == "TEST."
  45 $!
  46 $!  Make sure we are where we need to be.
  47 $   If F$Search("t.dir").nes.""
  48 $   Then
  49 $       Set Default [.t]
  50 $   Else
  51 $       If F$TrnLNm("Perl_Root").nes.""
  52 $       Then
  53 $           Set Default Perl_Root:[t]
  54 $       Else
  55 $           Write Sys$Error "Can't find test directory"
  56 $           $status = 44
  57 $           goto wrapup
  58 $       EndIf
  59 $   EndIf
  60 $!
  61 $!  Pick up a copy of perl to use for the tests
  62 $   If F$Search("Perl''exe'").nes."" Then Delete/Log/NoConfirm Perl'exe';*
  63 $   If PERL_TEST_DRIVER .eqs. "minitest"
  64 $   Then
  65 $       Copy/Log/NoConfirm [-]miniperl'exe' []Perl'exe'
  66 $   Else
  67 $       Copy/Log/NoConfirm [-]'ndbg'Perl'exe' []Perl'exe'
  68 $   EndIf
  69 $!
  70 $!  Pick up a copy of vmspipe.com to use for the tests
  71 $   If F$Search("VMSPIPE.COM").nes."" then Delete/Log/Noconfirm VMSPIPE.COM;*
  72 $   Copy/Log/NoConfirm [-]VMSPIPE.COM []
  73 $!
  74 $!  This may be set for the C compiler in descrip.mms, but it confuses the File::Find tests
  75 $   if f$trnlnm("sys") .nes. "" then Define sys " "
  76 $!
  77 $!  And do it
  78 $   Set Message /NoFacility/NoSeverity/NoIdentification/NoText
  79 $   Show Process/Accounting
  80 $   testdir = "Directory/NoHead/NoTrail/Column=1"
  81 $   PerlShr_filespec = f$parse("Sys$Disk:[-]''dbg'PerlShr''exe'")
  82 $   Define 'dbg'Perlshr 'PerlShr_filespec'
  83 $   If F$Mode() .nes. "INTERACTIVE" Then Define/Nolog PERL_SKIP_TTY_TEST 1
  84 $   If PERL_TEST_DRIVER .eqs. "minitest"
  85 $   Then
  86 $       MCR Sys$Disk:[]Perl'exe' TEST. "-minitest" "base/*.t" "comp/*.t" "cmd/*.t" "run/*.t" "io/*.t" "op/*.t" "uni/*.t"
  87 $   Else
  88 $       MCR Sys$Disk:[]Perl'exe' "-I[-.lib]" 'PERL_TEST_DRIVER' "''p3'" "''p4'" "''p5'" "''p6'" "''p7'"
  89 $   EndIf
  90 $   goto wrapup
  91 $!
  92 $ Control_Y_exit:
  93 $   $status = 1552   ! %SYSTEM-W-CONTROLY
  94 $!
  95 $ wrapup:
  96 $   status = $status
  97 $   If f$trnlnm("''dbg'PerlShr") .nes. "" Then DeAssign 'dbg'PerlShr
  98 $   Show Process/Accounting
  99 $   If f$type(olddef) .nes. "" Then Set Default &olddef
 100 $   If f$type(oldmsg) .nes. "" Then Set Message 'oldmsg'
 101 $   If f$type(oldpriv) .nes. "" Then discard = F$SetPrv(oldpriv)
 102 $   Exit status