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$ PerlShr_filespec = f$parse("Sys$Disk:[-]''dbg'PerlShr''exe'") 81$ Define 'dbg'Perlshr 'PerlShr_filespec' 82$ If F$Mode() .nes. "INTERACTIVE" Then Define/Nolog PERL_SKIP_TTY_TEST 1 83$ If PERL_TEST_DRIVER .eqs. "minitest" 84$ Then 85$ MCR Sys$Disk:[]Perl'exe' TEST. "base/*.t" "comp/*.t" "cmd/*.t" "run/*.t" "io/*.t" "op/*.t" "uni/*.t" 86$ Else 87$ MCR Sys$Disk:[]Perl'exe' "-I[-.lib]" 'PERL_TEST_DRIVER' "''p3'" "''p4'" "''p5'" "''p6'" "''p7'" 88$ EndIf 89$ goto wrapup 90$! 91$ Control_Y_exit: 92$ $status = 1552 ! %SYSTEM-W-CONTROLY 93$! 94$ wrapup: 95$ status = $status 96$ If f$trnlnm("''dbg'PerlShr") .nes. "" Then DeAssign 'dbg'PerlShr 97$ Show Process/Accounting 98$ If f$type(olddef) .nes. "" Then Set Default &olddef 99$ If f$type(oldmsg) .nes. "" Then Set Message 'oldmsg' 100$ If f$type(oldpriv) .nes. "" Then discard = F$SetPrv(oldpriv) 101$ Exit status 102