file spec tweaks for VMS
Craig A. Berry [Wed, 18 Sep 2002 16:57:02 +0000 (11:57 -0500)]
From: "Craig A. Berry" <craigberry@mac.com>
Message-ID: <3D88F6AE.3020708@mac.com>

p4raw-id: //depot/perl@17913

lib/File/Spec/VMS.pm
vms/ext/filespec.t

index f21ff5e..54fcee1 100644 (file)
@@ -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) {
index 7123ffc..559659f 100644 (file)
@@ -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_/