I've finally gotten around to making t/TEST work properly on VMS.
The patch is below and works with bleadperl on VMS and also works as
before on Mac OS X. If this is too ugly or too late for 5.8.0 I can
live with that. However, there are several advantages here for us.
1.) We could stop maintaining a separate test driver in vms/test.com
(I'll submit a follow-on patch if this is accepted).
2.) We have been failing to pick up the following tests for some
reason but we will run them if we start using t/TEST (sorry,
case-leveled names):
lib/class/isa/test
lib/i18n/langtags/test
lib/locale/maketext/test
lib/term/ansicolor/test
3.) There were some tests we've been running twice (ext/lib/io...).
So, this does fix existing bugs as well as improving long-term maintainability.
--- t/TEST_ORIG Thu Apr 25 19:41:24 2002
+++ t/TEST Thu Apr 25 23:39:15 2002
@@ -9,6 +9,9 @@
# which live dual lives on CPAN.
$ENV{PERL_CORE} = 1;
+# remove empty elements due to insertion of empty symbols via "''p1'" syntax
+@ARGV = grep($_,@ARGV) if $^O eq 'VMS';
+
# Cheesy version of Getopt::Std. Maybe we should replace it with that.
@argv = ();
if ($#ARGV >= 0) {
@@ -64,26 +67,40 @@
foreach my $f (sort { $a cmp $b } readdir DIR) {
next if $f eq $curdir or $f eq $updir;
- my $fullpath = File::Spec->catdir($dir, $f);
+ my $fullpath = File::Spec->catfile($dir, $f);
_find_tests($fullpath) if -d $fullpath;
+ $fullpath = VMS::Filespec::unixify($fullpath) if $^O eq 'VMS';
push @ARGV, $fullpath if $f =~ /\.t$/;
}
}
+sub _quote_args {
+ my ($args) = @_;
+ my $argstring = '';
+
+ foreach (split(/\s+/,$args)) {
+ # In VMS protect with doublequotes because otherwise
+ # DCL will lowercase -- unless already doublequoted.
+ $_ = q(").$_.q(") if ($^O eq 'VMS') && !/^\"/ && length($_) > 0;
+ $argstring .= ' ' . $_;
+ }
+ return $argstring;
+}
+
unless (@ARGV) {
foreach my $dir (qw(base comp cmd run io op uni)) {
_find_tests($dir);
}
_find_tests("lib") unless $core;
- my $mani = File::Spec->catdir($updir, "MANIFEST");
+ my $mani = File::Spec->catfile($updir, "MANIFEST");
if (open(MANI, $mani)) {
while (<MANI>) { # similar code in t/harness
if (m!^(ext/\S+/?([^/]+\.t|test\.pl)|lib/\S+?(\.t|test\.pl))\s!) {
$t = $1;
if (!$core || $t =~ m!^lib/[a-z]!)
{
- $path = File::Spec->catdir($updir, $t);
+ $path = File::Spec->catfile($updir, $t);
push @ARGV, $path;
$name{$path} = $t;
}
@@ -139,8 +156,12 @@
$files = 0;
$totmax = 0;
- foreach (@tests) {
- $name{$_} = File::Spec->catdir('t',$_) unless exists $name{$_};
+ foreach my $t (@tests) {
+ unless (exists $name{$t}) {
+ my $tname = File::Spec->catfile('t',$t);
+ $tname = VMS::Filespec::unixify($tname) if $^O eq 'VMS';
+ $name{$t} = $tname;
+ }
}
my $maxlen = 0;
foreach (@name{@tests}) {
@@ -169,8 +190,12 @@
next;
}
}
- $te = $name{$test};
- print "$te" . '.' x ($dotdotdot - length($te));
+ $te = $name{$test} . '.' x ($dotdotdot - length($name{$test}));
+
+ if ($^O ne 'VMS') { # defer printing on VMS due to piping bug
+ print $te;
+ $te = '';
+ }
$test = $OVER{$test} if exists $OVER{$test};
@@ -208,7 +233,8 @@
}
elsif ($type eq 'perl') {
my $perl = $ENV{PERL} || './perl';
- my $run = "$perl $testswitch $switch $utf $test |";
+ my $redir = ($^O eq 'VMS' ? '2>&1' : '');
+ my $run = "$perl" . _quote_args("$testswitch $switch $utf") . " $test
+$redir|";
open(RESULTS,$run) or print "can't run '$run': $!.\n";
}
else {
@@ -246,6 +272,7 @@
$ok = 0;
$next = 0;
while (<RESULTS>) {
+ next if /^\s*$/; # skip blank lines
if ($verbose) {
print $_;
}
@@ -304,17 +331,17 @@
}
if ($ok && $next == $max ) {
if ($max) {
- print "ok\n";
+ print "${te}ok\n";
$good = $good + 1;
}
else {
- print "skipping test on this platform\n";
+ print "${te}skipping test on this platform\n";
$files -= 1;
}
}
else {
$next += 1;
- print "FAILED at test $next\n";
+ print "${te}FAILED at test $next\n";
$bad = $bad + 1;
$_ = $test;
if (/^base/) {
[end of patch]
--
________________________________________
Craig A. Berry
mailto:[EMAIL PROTECTED]
"... getting out of a sonnet is much more
difficult than getting in."
Brad Leithauser
