In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3420b9a3ac5c603e264b6d5f4e1a58dee36532e4?hp=47ed9d9e89922a8e165d6dfc5737772cc5ee7a45>
- Log ----------------------------------------------------------------- commit 3420b9a3ac5c603e264b6d5f4e1a58dee36532e4 Author: Craig A. Berry <[email protected]> Date: Sat Feb 13 09:47:11 2016 -0600 Make File::Spec::VMS->abs2rel handle Unix-format input. We had been living under the illusion that when passed Unix-format input, this routine could just punt to File::Spec::Unix-abs2rel. However, the latter calls canonpath, which returns native specs, and we ended up mixing native semantics with Unix-format semantics and got nonsense. For example, abs2rel('/d1/foo/bar.pl') could become '[bar.pl]'. So instead we now follow the same basic logic regardless of input format and there are tests to make sure abs2rel works with both. ----------------------------------------------------------------------- Summary of changes: dist/PathTools/Cwd.pm | 2 +- dist/PathTools/lib/File/Spec.pm | 2 +- dist/PathTools/lib/File/Spec/AmigaOS.pm | 2 +- dist/PathTools/lib/File/Spec/Cygwin.pm | 2 +- dist/PathTools/lib/File/Spec/Epoc.pm | 2 +- dist/PathTools/lib/File/Spec/Functions.pm | 2 +- dist/PathTools/lib/File/Spec/Mac.pm | 2 +- dist/PathTools/lib/File/Spec/OS2.pm | 2 +- dist/PathTools/lib/File/Spec/Unix.pm | 2 +- dist/PathTools/lib/File/Spec/VMS.pm | 10 ++++------ dist/PathTools/lib/File/Spec/Win32.pm | 2 +- dist/PathTools/t/Spec.t | 6 ++++-- 12 files changed, 18 insertions(+), 18 deletions(-) diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm index 9b5183e..e8b9f19 100644 --- a/dist/PathTools/Cwd.pm +++ b/dist/PathTools/Cwd.pm @@ -3,7 +3,7 @@ use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); -$VERSION = '3.62'; +$VERSION = '3.63'; my $xs_version = $VERSION; $VERSION =~ tr/_//d; diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm index 2709c39..32b987e 100644 --- a/dist/PathTools/lib/File/Spec.pm +++ b/dist/PathTools/lib/File/Spec.pm @@ -3,7 +3,7 @@ package File::Spec; use strict; use vars qw(@ISA $VERSION); -$VERSION = '3.62'; +$VERSION = '3.63'; $VERSION =~ tr/_//d; my %module = (MacOS => 'Mac', diff --git a/dist/PathTools/lib/File/Spec/AmigaOS.pm b/dist/PathTools/lib/File/Spec/AmigaOS.pm index e6d6f5f2a..075c36a 100644 --- a/dist/PathTools/lib/File/Spec/AmigaOS.pm +++ b/dist/PathTools/lib/File/Spec/AmigaOS.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.62'; +$VERSION = '3.63'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm index 67f056f..2092eb8 100644 --- a/dist/PathTools/lib/File/Spec/Cygwin.pm +++ b/dist/PathTools/lib/File/Spec/Cygwin.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.62'; +$VERSION = '3.63'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm index 17e3f54..22f0192 100644 --- a/dist/PathTools/lib/File/Spec/Epoc.pm +++ b/dist/PathTools/lib/File/Spec/Epoc.pm @@ -3,7 +3,7 @@ package File::Spec::Epoc; use strict; use vars qw($VERSION @ISA); -$VERSION = '3.62'; +$VERSION = '3.63'; $VERSION =~ tr/_//d; require File::Spec::Unix; diff --git a/dist/PathTools/lib/File/Spec/Functions.pm b/dist/PathTools/lib/File/Spec/Functions.pm index 470c771..af2c498 100644 --- a/dist/PathTools/lib/File/Spec/Functions.pm +++ b/dist/PathTools/lib/File/Spec/Functions.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); -$VERSION = '3.62'; +$VERSION = '3.63'; $VERSION =~ tr/_//d; require Exporter; diff --git a/dist/PathTools/lib/File/Spec/Mac.pm b/dist/PathTools/lib/File/Spec/Mac.pm index 329451f..52c3bfe 100644 --- a/dist/PathTools/lib/File/Spec/Mac.pm +++ b/dist/PathTools/lib/File/Spec/Mac.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.62'; +$VERSION = '3.63'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm index 55e6d33..804ecdb 100644 --- a/dist/PathTools/lib/File/Spec/OS2.pm +++ b/dist/PathTools/lib/File/Spec/OS2.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.62'; +$VERSION = '3.63'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm index 586e9b0..3916a11 100644 --- a/dist/PathTools/lib/File/Spec/Unix.pm +++ b/dist/PathTools/lib/File/Spec/Unix.pm @@ -3,7 +3,7 @@ package File::Spec::Unix; use strict; use vars qw($VERSION); -$VERSION = '3.62'; +$VERSION = '3.63'; my $xs_version = $VERSION; $VERSION =~ tr/_//d; diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm index 600c49f..02cc0b0 100644 --- a/dist/PathTools/lib/File/Spec/VMS.pm +++ b/dist/PathTools/lib/File/Spec/VMS.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.62'; +$VERSION = '3.63'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); @@ -437,15 +437,13 @@ Attempt to convert an absolute file specification to a relative specification. sub abs2rel { my $self = shift; - return vmspath(File::Spec::Unix::abs2rel( $self, @_ )) - if ((grep m{/}, @_) && !(grep m{(?<!\^)[\[<:]}, @_)); - my($path,$base) = @_; + $base = $self->_cwd() unless defined $base and length $base; # If there is no device or directory syntax on $base, make sure it # is treated as a directory. - $base = VMS::Filespec::vmspath($base) unless $base =~ m{(?<!\^)[\[<:]}; + $base = vmspath($base) unless $base =~ m{(?<!\^)[\[<:]}; for ($path, $base) { $_ = $self->rel2abs($_) } @@ -461,7 +459,7 @@ sub abs2rel { my ($path_volume, $path_directories, $path_file) = $self->splitpath($path); my ($base_volume, $base_directories, $base_file) = $self->splitpath($base); - return $path unless lc($path_volume) eq lc($base_volume); + return $self->canonpath( $path ) unless lc($path_volume) eq lc($base_volume); # Now, remove all leading components that are the same my @pathchunks = $self->splitdir( $path_directories ); diff --git a/dist/PathTools/lib/File/Spec/Win32.pm b/dist/PathTools/lib/File/Spec/Win32.pm index 6df7ee8..1105b67 100644 --- a/dist/PathTools/lib/File/Spec/Win32.pm +++ b/dist/PathTools/lib/File/Spec/Win32.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.62'; +$VERSION = '3.63'; $VERSION =~ tr/_//d; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/t/Spec.t b/dist/PathTools/t/Spec.t index 74c18aa..150c8d4 100644 --- a/dist/PathTools/t/Spec.t +++ b/dist/PathTools/t/Spec.t @@ -447,7 +447,7 @@ my @tests = ( [ "VMS->canonpath('[d1.d2.--]file')", $vms_unix_rpt ? '../file.txt' : '[000000]file' ], # During the Perl 5.8 era, FS::Unix stopped eliminating redundant path elements, so mimic that here. [ "VMS->canonpath('a/../../b/c.dat')", $vms_unix_rpt ? 'a/../../b/c.dat' : '[-.b]c.dat' ], -[ "VMS->canonpath('^<test^.new.-.caret^ escapes^>')", '^<test^.new.-.caret^ escapes^>' ], +[ "VMS->canonpath('^<test^.new.-.caret^ escapes^>')", $vms_unix_rpt ? '/<test.new.-.caret escapes>' : '^<test^.new.-.caret^ escapes^>' ], [ "VMS->splitdir('')", '' ], [ "VMS->splitdir('[]')", '' ], @@ -483,6 +483,8 @@ my @tests = ( [ "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", $vms_unix_rpt ? '/node//volume/t1/t2/t3/' : 'node::volume:[t1.t2.t3]' ], [ "VMS->abs2rel('node::volume:[t1.t2.t4]','node::volume:[t1.t2.t3]')", $vms_unix_rpt ? '../t4/' : '[-.t4]' ], [ "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", $vms_unix_rpt ? '/node//volume/t1/t2/t4/' : 'node::volume:[t1.t2.t4]' ], +[ "VMS->abs2rel('/volume/t1/t2/t3','/volume/t1')", $vms_unix_rpt ? 't2/t3' : '[.t2]t3' ], +[ "VMS->abs2rel('/volume/t1/t2/t3/t4','/volume/t1/xyz')", $vms_unix_rpt ? '../t2/t3/t4' : '[-.t2.t3]t4' ], [ "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')", $vms_unix_rpt ? './' : '[]' ], [ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')", 'file' ], [ "VMS->abs2rel('[t1.t2.t3]file','[t1.t2]')", $vms_unix_rpt ? 't3/file' : '[.t3]file' ], @@ -493,7 +495,7 @@ my @tests = ( [ "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')", $vms_unix_rpt ? '../../../t4/t5/t6/' : '[---.t4.t5.t6]' ], [ "VMS->abs2rel('[000000]','[t1.t2.t3]')", $vms_unix_rpt ? '../../../' : '[---]' ], [ "VMS->abs2rel('a:[t1.t2.t4]','a:[t1.t2.t3]')", $vms_unix_rpt ? '../t4/' : '[-.t4]' ], -[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')", $vms_unix_rpt ? '/a/t1/t2/t4/' : 'a:[t1.t2.t4]' ], +[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')", $vms_unix_rpt ? '/a/t1/t2/t4' : 'a:[t1.t2.t4]' ], [ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')", $vms_unix_rpt ? '../../../b/' : '[---.b]' ], [ "VMS->rel2abs('[.t4]','[t1.t2.t3]')", $vms_unix_rpt ? '/sys$disk/t1/t2/t3/t4/' : '[t1.t2.t3.t4]' ], -- Perl5 Master Repository
