The patch below fixes the following two test failures that I encountered
with Compaq C 6.4 on OpenVMS Alpha 7.2-1:
t/lib/vmsfspec.......................FAILED at test 70
lib/File/Spec/t/Spec.................FAILED at test 161
We needed to update canonpath() and catfile()'s use of canonpath() to
catch up with what change 17828 did for other platforms. We also had to
catch up with the fact that is() in t/test.pl now makes a distinction
between zero-length strings and undef in its result argument. While I
was in there I made the output of vms/ext/filespec.t slightly more
verbose about what it's doing.
The following test still fails:
ext/threads/shared/t/disabled........FAILED at test 0
It fails because we don't build threads::shared with a non-thread
configuration. I'm afraid I don't understand the rationale of this
test. Should I really be building the extension for the sole purpose of
running a test that proves the extension is unavailable?
--- lib/File/Spec/VMS.pm;-0 Thu Aug 22 18:00:09 2002
+++ lib/File/Spec/VMS.pm Wed Sep 18 14:46:13 2002
@@ -164,6 +164,7 @@
$path =~ s/([\[<])(-+)/$1 . "\cx" x length($2)/e; # encode leading '-'s
$path =~ s/([\[<\.])([^\[<\.\cx]+)\.-\.?/$1/g; # bar.-.foo ==> foo
$path =~ s/([\[<])(\cx+)/$1 . '-' x length($2)/e; # then decode
+ $path =~ s/^[\[<\]>]{2}//; # []foo ==> foo
return $path;
}
}
@@ -211,7 +212,7 @@
sub catfile {
my ($self,@files) = @_;
- my $file = pop @files;
+ my $file = $self->canonpath(pop @files);
@files = grep($_,@files);
my $rslt;
if (@files) {
--- vms/ext/filespec.t;-0 Thu Aug 22 18:01:12 2002
+++ vms/ext/filespec.t Wed Sep 18 14:36:00 2002
@@ -18,16 +18,17 @@
foreach $test (@tests) {
($arg,$func,$expect) = split(/\s+/,$test);
+ $expect = undef if $expect eq 'undef';
$rslt = eval "$func('$arg')";
- is($@, '', "eval func('$arg')");
- is($rslt, $expect, " result");
+ is($@, '', "eval ${func}('$arg')");
+ is($rslt, $expect, "${func}('$arg'): '$rslt'");
}
$defwarn = <<'EOW';
# Note: This failure may have occurred because your default device
# was set using a non-concealed logical name. If this is the case,
# you will need to determine by inspection that the two resultant
-# file specifications shwn above are in fact equivalent.
+# file specifications shown above are in fact equivalent.
EOW
is(uc(rmsexpand('[]')), "\U$ENV{DEFAULT}", 'rmsexpand()') || print $defwarn;
@@ -86,9 +87,9 @@
__down_/__the_/__garden_/__path_ fileify __down_/__the_/__garden_/__path_.dir;1
__down_:[__the_.__garden_]__path_ fileify __down_:[__the_.__garden_]__path_.dir;1
__down_:[__the_.__garden_]__path_. fileify # N.B. trailing . ==> null type
-__down_:[__the_]__garden_.__path_ fileify
+__down_:[__the_]__garden_.__path_ fileify undef
/__down_/__the_/__garden_/__path_. fileify # N.B. trailing . ==> null type
-/__down_/__the_/__garden_.__path_ fileify
+/__down_/__the_/__garden_.__path_ fileify undef
# and pathifying them
__down_:[__the_.__garden_]__path_.dir;1 pathify
__down_:[__the_.__garden_.__path_]
@@ -97,15 +98,15 @@
__down_/__the_/__garden_/__path_.dir pathify __down_/__the_/__garden_/__path_/
__down_:[__the_.__garden_]__path_ pathify __down_:[__the_.__garden_.__path_]
__down_:[__the_.__garden_]__path_. pathify # N.B. trailing . ==> null type
-__down_:[__the_]__garden_.__path_ pathify
+__down_:[__the_]__garden_.__path_ pathify undef
/__down_/__the_/__garden_/__path_. pathify # N.B. trailing . ==> null type
-/__down_/__the_/__garden_.__path_ pathify
+/__down_/__the_/__garden_.__path_ pathify undef
__down_:[__the_.__garden_]__path_.dir;2 pathify #N.B. ;2
__path_ pathify __path_/
/__down_/__the_/__garden_/. pathify /__down_/__the_/__garden_/./
/__down_/__the_/__garden_/.. pathify /__down_/__the_/__garden_/../
/__down_/__the_/__garden_/... pathify /__down_/__the_/__garden_/.../
-__path_.notdir pathify
+__path_.notdir pathify undef
# Both VMS/Unix and file/path conversions
__down_:[__the_.__garden_]__path_.dir;1 unixpath
/__down_/__the_/__garden_/__path_/
