diff options
author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1996-03-22 01:54:27 +0000 |
---|---|---|
committer | Charles Bailey <bailey@genetics.upenn.edu> | 1996-03-22 01:54:27 +0000 |
commit | 34b5aed4c5693a5ad2881bc127e32e733bbafc9a (patch) | |
tree | fb0773ef03b641d33491fe91fe6fcf1e69568f35 /vms | |
parent | 4e5920371291a32f75d2d5f52b66f3242b01c1b8 (diff) | |
download | perl-34b5aed4c5693a5ad2881bc127e32e733bbafc9a.tar.gz |
Allow more compact output format, and pass params to Perl driver
Diffstat (limited to 'vms')
-rw-r--r-- | vms/test.com | 28 |
1 files changed, 15 insertions, 13 deletions
diff --git a/vms/test.com b/vms/test.com index 5c4a7a1ef3..05ff0bba6c 100644 --- a/vms/test.com +++ b/vms/test.com @@ -72,7 +72,7 @@ $ $! And do it $ testdir = "Directory/NoHead/NoTrail/Column=1" $ Define/User Perlshr Sys$Disk:[-]PerlShr.Exe -$ MCR Sys$Disk:[]Perl. +$ MCR Sys$Disk:[]Perl. "''p1'" "''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 @@ -92,18 +92,19 @@ foreach $file (@exclist) { $skip{$file}++; } $| = 1; -#if ($ARGV[0] eq '-v') { +@ARGV = grep($_,@ARGV); # remove empty elements due to "''p1'" syntax + +if ($ARGV[0] eq '-v') { $verbose = 1; -# shift; -#} + shift; +} chdir 't' if -f 't/TEST'; if ($ARGV[0] eq '') { - @files = split(/[ \n]/, `\$ testdir [...]*.t;`); - foreach (@files) { - $fname = $_; - $fname =~ s/.*\]([\w\$\-]+\.T);.*/$1/; + foreach (<[.*]*.t>) { + s/.*[\[.]t./[./; + ($fname = $_) =~ s/.*\]//; if ($skip{"\L$fname"}) { push(@skipped,$_); } else { push(@ARGV,$_); } } @@ -112,7 +113,7 @@ if ($ARGV[0] eq '') { 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); + print "\t",join("\n\t",@skipped),"\n\n"; } $bad = 0; @@ -124,7 +125,7 @@ while ($test = shift) { } $te = $test; chop($te); - print "$te" . '.' x (15 - length($te)) . "\n"; + $te .= '.' x (24 - length($te)); open(script,"$test") || die "Can't run $test.\n"; $_ = <script>; close(script); @@ -138,7 +139,8 @@ while ($test = shift) { $next = 0; while (<results>) { if ($verbose) { - print $_; + print "$te$_"; + $te = ''; } unless (/^#/) { if (/^1\.\.([0-9]+)/) { @@ -160,11 +162,11 @@ while ($test = shift) { } $next = $next - 1; if ($ok && $next == $max) { - print "ok\n"; + print "${te}ok\n"; $good = $good + 1; } else { $next += 1; - print "FAILED on test $next\n"; + print "${te}FAILED on test $next\n"; $bad = $bad + 1; $_ = $test; if (/^base/) { |