| 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. "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 |