1 $! Test.Com - DCL driver for perl5 regression tests
3 $! Version 1.1 4-Dec-1995
4 $! Charles Bailey bailey@newman.upenn.edu
6 $! A little basic setup
7 $ On Error Then Goto wrapup
8 $ olddef = F$Environment("Default")
9 $ oldmsg = F$Environment("Message")
10 $ If F$Search("t.dir").nes.""
14 $ If F$TrnLNm("Perl_Root").nes.""
16 $ Set Default Perl_Root:[t]
18 $ Write Sys$Error "Can't find test directory"
22 $ Set Message /NoFacility/NoSeverity/NoIdentification/NoText
25 $ If p1.nes."" Then exe = p1
26 $ If F$Extract(0,1,exe) .nes. "."
29 $ Write Sys$Error "The first parameter passed to Test.Com must be the file type used for the"
30 $ Write Sys$Error "images produced when you built Perl (i.e. "".Exe"", unless you edited"
31 $ Write Sys$Error "Descrip.MMS or used the AXE=1 macro in the MM[SK] command line."
36 $! "debug" perl if second parameter is nonblank
40 $ if p2.nes."" then dbg = "dbg"
41 $ if p2.nes."" then ndbg = "ndbg"
43 $! Pick up a copy of perl to use for the tests
44 $ If F$Search("Perl.").nes."" Then Delete/Log/NoConfirm Perl.;*
45 $ Copy/Log/NoConfirm [-]'ndbg'Perl'exe' []Perl.
47 $! Pick up a copy of vmspipe.com to use for the tests
48 $ If F$Search("VMSPIPE.COM").nes."" then Delete/Log/Noconfirm VMSPIPE.COM;*
49 $ Copy/Log/NoConfirm [-]VMSPIPE.COM []
52 $ Show Process/Accounting
53 $ testdir = "Directory/NoHead/NoTrail/Column=1"
54 $ PerlShr_filespec = f$parse("Sys$Disk:[-]''dbg'PerlShr''exe'")
55 $ Define 'dbg'Perlshr 'PerlShr_filespec'
56 $ if f$mode() .nes. "INTERACTIVE" then Define PERL_SKIP_TTY_TEST 1
57 $ MCR Sys$Disk:[]Perl. "-I[-.lib]" - "''p3'" "''p4'" "''p5'" "''p6'"
58 $ Deck/Dollar=$$END-OF-TEST$$
60 # The bulk of the below code is scheduled for deletion. test.com
61 # will shortly use t/TEST.
69 # Let tests know they're running in the perl core. Useful for modules
70 # which live dual lives on CPAN.
73 @ARGV = grep($_,@ARGV); # remove empty elements due to "''p1'" syntax
75 if (lc($ARGV[0]) eq '-v') {
80 chdir 't' if -f 't/TEST';
83 foreach (<[.*]*.t>, <[-.ext...]*.t>, <[-.lib...]*.t>) {
84 $_ = File::Spec->abs2rel($_);
85 s/\[([a-z]+)/[.$1/; # hmm, abs2rel doesn't do subdirs of the cwd
86 ($fname = $_) =~ s/.*\]//;
95 while ($test = shift) {
101 $te .= '.' x (40 - length($te));
102 open(script,"$test") || die "Can't run $test.\n";
105 if (/#!.*\bperl.*-\w*([tT])/) {
110 open(results,"\$ MCR Sys\$Disk:[]Perl. \"-I[-.lib]\" $switch $test 2>&1|") || (print "can't run.\n");
120 if (/^1\.\.([0-9]+)( todo ([\d ]+))?/) {
122 %todo = map { $_ => 1 } split / /, $3 if $3;
128 # our 'echo' substitute produces one more \n than Unix'
132 if (/^(not )?ok (\d+)[^#]*(\s*#.*)?/ &&
135 my($not, $num, $extra) = ($1, $2, $3);
136 my($istodo) = $extra =~ /^\s*#\s*TODO/ if $extra;
137 $istodo = 1 if $todo{$num};
139 if( $not && !$istodo ) {
144 elsif( $pending_not ) {
153 # VMS has this problem. It sometimes adds newlines
154 # between prints. This sometimes means you get
158 elsif (/^Bail out!\s*(.*)/i) { # magic words
159 die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
169 if ($ok && $next == $max) {
174 print "${te}skipping test on this platform\n";
176 $extra_skip = $extra_skip + 1;
180 print "${te}FAILED on test $next\n";
184 die "Failed a basic test--cannot continue.\n";
191 print "All tests successful.\n";
193 die "FAILED--no tests were run for some reason.\n";
196 # $pct = sprintf("%.2f", $good / $total * 100);
197 $gtotal = $total - $extra_skip;
198 if ($gtotal <= 0) { $gtotal = $total; }
199 $pct = sprintf("%.2f", $good / $gtotal * 100);
201 warn "Failed 1 test, $pct% okay.\n";
203 if ($extra_skip > 0) {
204 warn "Total tests: $total, Passed $good, Skipped $extra_skip.\n";
205 warn "Failed $bad/$gtotal tests, $pct% okay.\n";
208 warn "Total tests: $total, Passed $good.\n";
209 warn "Failed $bad/$gtotal tests, $pct% okay.\n";
213 ($user,$sys,$cuser,$csys) = times;
214 print sprintf("u=%g s=%g cu=%g cs=%g scripts=%d tests=%d\n",
215 $user,$sys,$cuser,$csys,$files,$totmax);
218 $ deassign 'dbg'Perlshr
219 $ Show Process/Accounting
220 $ Set Default &olddef
221 $ Set Message 'oldmsg'