diff options
| author | Craig A. Berry <craigberry@mac.com> | 2013-07-14 14:34:47 -0500 |
|---|---|---|
| committer | Craig A. Berry <craigberry@mac.com> | 2013-07-14 16:22:58 -0500 |
| commit | fc827b9c4e5510a7f8f0fc51532bbac29d6e7a05 (patch) | |
| tree | 52df491e0bfbd0476e2025dcfc09d712fbc27433 /dist/Cwd | |
| parent | 8371a44dad2a56f86ef3089ef823ea893fbc86db (diff) | |
| download | perl-fc827b9c4e5510a7f8f0fc51532bbac29d6e7a05.tar.gz | |
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.
Diffstat (limited to 'dist/Cwd')
| -rw-r--r-- | dist/Cwd/lib/File/Spec/VMS.pm | 4 | ||||
| -rw-r--r-- | dist/Cwd/t/Spec.t | 4 |
2 files changed, 6 insertions, 2 deletions
diff --git a/dist/Cwd/lib/File/Spec/VMS.pm b/dist/Cwd/lib/File/Spec/VMS.pm index 6c3363d5ed..8fb79dbbe7 100644 --- 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 de6d23792d..aed658d0f5 100644 --- 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' ], |