Fix file_name_is_absolute on VMS for device without a directory.

To be considered absolute, we had been requiring a file spec to
have a bracketed directory spec after the colon. This meant that
very common and idiomatic expressions such as sys$login:login.com
or sys$manager:operator.log were not considered absolute.  Which
is wrong.

So we now consider a file spec starting with a valid device name
(which would also be a valid logical name) followed by an unescaped
colon to be absolute.

diff --git a/dist/Cwd/lib/File/Spec/VMS.pm b/dist/Cwd/lib/File/Spec/VMS.pm
index 6c3363d..8fb79db 100644 (file)
--- a/dist/Cwd/lib/File/Spec/VMS.pm
+++ b/dist/Cwd/lib/File/Spec/VMS.pm
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.42';
+$VERSION = '3.43';
 $VERSION =~ tr/_//;
 
 @ISA = qw(File::Spec::Unix);
@@ -336,7 +336,7 @@ sub file_name_is_absolute {
     $file = $ENV{$file} while $file =~ /^[\w\$\-]+\Z(?!\n)/s && $ENV{$file};
     return scalar($file =~ m!^/!s             ||
                  $file =~ m![<\[][^.\-\]>]!  ||
-                 $file =~ /:[^<\[]/);
+                 $file =~ /^[A-Za-z0-9_\$\-\~]+(?<!\^):/);
 }
 
 =item splitpath (override)

diff --git a/dist/Cwd/t/Spec.t b/dist/Cwd/t/Spec.t
index de6d237..aed658d 100644 (file)
--- a/dist/Cwd/t/Spec.t
+++ b/dist/Cwd/t/Spec.t
@@ -468,6 +468,10 @@ my @tests = (
 [ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')",         $vms_unix_rpt ? '/sys$disk/t1/t2/t4/'       : '[t1.t2.t4]'       ],
 [ "VMS->rel2abs('[t1]','[t1.t2.t3]')",           $vms_unix_rpt ? '/sys$disk/t1/'             : '[t1]'             ],
 
+[ "VMS->file_name_is_absolute('foo:')",                '1'  ],
+[ "VMS->file_name_is_absolute('foo:bar.dat')",         '1'  ],
+[ "VMS->file_name_is_absolute('foo:[000000]bar.dat')", '1'  ],
+
 [ "OS2->case_tolerant()",         '1'  ],
 
 [ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ],