From: Craig A. Berry <craigberry@mac.com>
Date: Wed, 18 Sep 2002 16:57:02 +0000 (-0500)
Subject: file spec tweaks for VMS
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9ba1b7d248e0db6e26fa52ba8d5b3768aa0b633f;p=p5sagit%2Fp5-mst-13.2.git

file spec tweaks for VMS
From: "Craig A. Berry" <craigberry@mac.com>
Message-ID: <3D88F6AE.3020708@mac.com>

p4raw-id: //depot/perl@17913
---

diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm
index f21ff5e..54fcee1 100644
--- a/lib/File/Spec/VMS.pm
+++ b/lib/File/Spec/VMS.pm
@@ -164,6 +164,7 @@ sub canonpath {
       $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 @@ VMS-syntax file specification.
 
 sub catfile {
     my ($self,@files) = @_;
-    my $file = pop @files;
+    my $file = $self->canonpath(pop @files);
     @files = grep($_,@files);
     my $rslt;
     if (@files) {
diff --git a/vms/ext/filespec.t b/vms/ext/filespec.t
index 7123ffc..559659f 100644
--- a/vms/ext/filespec.t
+++ b/vms/ext/filespec.t
@@ -18,16 +18,17 @@ plan(tests => scalar(2*@tests)+6);
 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_
 __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;1        pathify __down_:[__the_.__garden_
 __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_/