X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/271404a7cade8c1013df65f89b040d5a3676fdd5..4c4c0bc28ce63bc1e3e0c34a9a60e3f9a92eb8b9:/vms/test.com diff --git a/vms/test.com b/vms/test.com index 156b2dc..709608e 100644 --- a/vms/test.com +++ b/vms/test.com @@ -1,11 +1,49 @@ -$! Test.Com - DCL driver for perl5 regression tests +$! Test.Com - DCL wrapper for perl5 regression test driver +$! +$! Version 2.0 25-April-2002 Craig Berry craigberry@mac.com +$! (and many other hands in the last 7+ years) +$! The most significant difference is that we now run the external t/TEST +$! rather than keeping a separately maintained test driver embedded here. $! $! Version 1.1 4-Dec-1995 -$! Charles Bailey bailey@genetics.upenn.edu -$ -$! A little basic setup +$! Charles Bailey bailey@newman.upenn.edu +$! +$! Set up error handler and save things we'll restore later. +$ On Control_Y Then Goto Control_Y_exit $ On Error Then Goto wrapup $ olddef = F$Environment("Default") +$ oldmsg = F$Environment("Message") +$ oldpriv = F$SetPrv("NOALL") ! downgrade privs for safety +$ discard = F$SetPrv("NETMBX,TMPMBX") ! only need these to run tests +$! +$! Process arguments. P1 is the file extension of the Perl images. +$! P2, when not empty, indicates that we are testing a version of Perl built +$! for the VMS debugger. The other arguments are passed directly to t/TEST. +$! +$ exe = ".Exe" +$ If p1.nes."" Then exe = p1 +$ If F$Extract(0,1,exe) .nes. "." +$ Then +$ Write Sys$Error "" +$ Write Sys$Error "The first parameter passed to Test.Com must be the file type used for the" +$ Write Sys$Error "images produced when you built Perl (i.e. "".Exe"", unless you edited" +$ Write Sys$Error "Descrip.MMS or used the AXE=1 macro in the MM[SK] command line." +$ Write Sys$Error "" +$ $status = 44 +$ goto wrapup +$ EndIf +$! +$! "debug" perl if second parameter is nonblank +$! +$ dbg = "" +$ ndbg = "" +$ if p2.nes."" then dbg = "dbg" +$ if p2.nes."" then ndbg = "ndbg" +$! +$! Run using "TEST." unless something else (e.g. "harness.") was specified. +$ If F$Type(PERL_TEST_DRIVER) .eqs. "" Then PERL_TEST_DRIVER == "TEST." +$! +$! Make sure we are where we need to be. $ If F$Search("t.dir").nes."" $ Then $ Set Default [.t] @@ -15,196 +53,50 @@ $ Then $ Set Default Perl_Root:[t] $ Else $ Write Sys$Error "Can't find test directory" -$ Exit 44 +$ $status = 44 +$ goto wrapup $ EndIf $ EndIf -$ -$ exe = ".Exe" -$ If p1.nes."" Then exe = p1 +$! $! Pick up a copy of perl to use for the tests -$ Delete/Log/NoConfirm Perl.;* -$ Copy/Log/NoConfirm [-]Perl'exe' []Perl. -$ -$! Make the environment look a little friendlier to tests which assume Unix -$ cat = "Type" -$ Macro/NoDebug/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 - 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 -$ Link/NoTrace/Exe=Echo.Exe Echo.Obj; -$ Delete/Log/NoConfirm Echo.Obj;* -$ echo = "$" + F$Parse("Echo.Exe") -$ +$ If F$Search("Perl''exe'").nes."" Then Delete/Log/NoConfirm Perl'exe';* +$ If PERL_TEST_DRIVER .eqs. "minitest" +$ Then +$ Copy/Log/NoConfirm [-]miniperl'exe' []Perl'exe' +$ Else +$ Copy/Log/NoConfirm [-]'ndbg'Perl'exe' []Perl'exe' +$ EndIf +$! +$! 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 [] +$! +$! This may be set for the C compiler in descrip.mms, but it confuses the File::Find tests +$ if f$trnlnm("sys") .nes. "" then Define sys " " +$! $! And do it +$ Set Message /NoFacility/NoSeverity/NoIdentification/NoText +$ Show Process/Accounting $ testdir = "Directory/NoHead/NoTrail/Column=1" -$ Define/User Perlshr Sys$Disk:[-]PerlShr'exe' -$ MCR Sys$Disk:[]Perl. "''p2'" "''p3'" "''p4'" "''p5'" "''p6'" -$ Deck/Dollar=$$END-OF-TEST$$ -# $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $ -# Modified for VMS 30-Sep-1994 Charles Bailey bailey@genetics.upenn.edu -# -# This is written in a peculiar style, since we're trying to avoid -# most of the constructs we'll be testing for. - -# 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.) -@compexcl=('cpp.t','script.t'); -@ioexcl=('argv.t','dup.t','fs.t','inplace.t','pipe.t'); -@libexcl=('anydbm.t','db-btree.t','db-hash.t','db-recno.t', - 'gdbm.t','io_dup.t', 'io_pipe.t', 'io_sock.t', - 'ndbm.t','odbm.t','posix.t','sdbm.t','soundex.t'); - # Note: POSIX is not part of basic build, but can be built - # separately if you're using DECC -@opexcl=('exec.t','fork.t','glob.t','groups.t','magic.t','misc.t','stat.t'); -@exclist=(@compexcl,@ioexcl,@libexcl,@opexcl); -foreach $file (@exclist) { $skip{$file}++; } - -$| = 1; - -@ARGV = grep($_,@ARGV); # remove empty elements due to "''p1'" syntax - -if ($ARGV[0] eq '-v') { - $verbose = 1; - shift; -} - -chdir 't' if -f 't/TEST'; - -if ($ARGV[0] eq '') { - foreach (<[.*]*.t>) { - s/.*[\[.]t./[./; - ($fname = $_) =~ s/.*\]//; - if ($skip{"\L$fname"}) { push(@skipped,$_); } - else { 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; -$total = @ARGV; -while ($test = shift) { - if ($test =~ /^$/) { - next; - } - $te = $test; - chop($te); - $te .= '.' x (24 - length($te)); - open(script,"$test") || die "Can't run $test.\n"; - $_ =