Commit | Line | Data |
---|---|---|
d082fec2 CB |
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. | |
a0d0e21e | 7 | $! |
e518068a | 8 | $! Version 1.1 4-Dec-1995 |
bd3fa61c | 9 | $! Charles Bailey bailey@newman.upenn.edu |
d9ae6319 | 10 | $! |
d082fec2 CB |
11 | $! Set up error handler and save things we'll restore later. |
12 | $ On Control_Y Then Goto Control_Y_exit | |
a0d0e21e | 13 | $ On Error Then Goto wrapup |
e518068a | 14 | $ olddef = F$Environment("Default") |
84902520 | 15 | $ oldmsg = F$Environment("Message") |
d082fec2 CB |
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. P2, | |
20 | $! when not empty, indicates that we are testing a version of Perl built for | |
21 | $! the VMS debugger. The other arguments are passed directly to t/TEST. | |
d9ae6319 | 22 | $! |
491527d0 GS |
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 "" | |
d082fec2 CB |
32 | $ $status = 44 |
33 | $ goto wrapup | |
491527d0 | 34 | $ EndIf |
3eeba6fb CB |
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 | $! | |
d082fec2 CB |
43 | $! Make sure we are where we need to be. |
44 | $ If F$Search("t.dir").nes."" | |
45 | $ Then | |
46 | $ Set Default [.t] | |
47 | $ Else | |
48 | $ If F$TrnLNm("Perl_Root").nes."" | |
49 | $ Then | |
50 | $ Set Default Perl_Root:[t] | |
51 | $ Else | |
52 | $ Write Sys$Error "Can't find test directory" | |
53 | $ $status = 44 | |
54 | $ goto wrapup | |
55 | $ EndIf | |
56 | $ EndIf | |
57 | $! | |
a0d0e21e | 58 | $! Pick up a copy of perl to use for the tests |
8713643e | 59 | $ If F$Search("Perl.").nes."" Then Delete/Log/NoConfirm Perl.;* |
3eeba6fb | 60 | $ Copy/Log/NoConfirm [-]'ndbg'Perl'exe' []Perl. |
59d8d783 CL |
61 | $! |
62 | $! Pick up a copy of vmspipe.com to use for the tests | |
63 | $ If F$Search("VMSPIPE.COM").nes."" then Delete/Log/Noconfirm VMSPIPE.COM;* | |
64 | $ Copy/Log/NoConfirm [-]VMSPIPE.COM [] | |
65 | $! | |
1e9d704e | 66 | $! This may be set for the C compiler in descrip.mms, but it confuses the File::Find tests |
139df077 | 67 | $ if f$trnlnm("sys") .nes. "" then Define sys " " |
1e9d704e | 68 | $! |
a0d0e21e | 69 | $! And do it |
d082fec2 | 70 | $ Set Message /NoFacility/NoSeverity/NoIdentification/NoText |
09b7f37c | 71 | $ Show Process/Accounting |
e518068a | 72 | $ testdir = "Directory/NoHead/NoTrail/Column=1" |
746380c8 CB |
73 | $ PerlShr_filespec = f$parse("Sys$Disk:[-]''dbg'PerlShr''exe'") |
74 | $ Define 'dbg'Perlshr 'PerlShr_filespec' | |
d082fec2 CB |
75 | $ If F$Mode() .nes. "INTERACTIVE" Then Define/Nolog PERL_SKIP_TTY_TEST 1 |
76 | $ MCR Sys$Disk:[]Perl. "-I[-.lib]" TEST. "''p3'" "''p4'" "''p5'" "''p6'" | |
77 | $ goto wrapup | |
78 | $! | |
79 | $ Control_Y_exit: | |
80 | $ $status = 1552 ! %SYSTEM-W-CONTROLY | |
81 | $! | |
a0d0e21e | 82 | $ wrapup: |
d082fec2 CB |
83 | $ status = $status |
84 | $ If f$trnlnm("''dbg'PerlShr") .nes. "" Then DeAssign 'dbg'PerlShr | |
09b7f37c | 85 | $ Show Process/Accounting |
d082fec2 CB |
86 | $ If f$type(olddef) .nes. "" Then Set Default &olddef |
87 | $ If f$type(oldmsg) .nes. "" Then Set Message 'oldmsg' | |
88 | $ If f$type(oldpriv) .nes. "" Then discard = F$SetPrv(oldpriv) | |
89 | $ Exit status |