This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make File::Spec::VMS->abs2rel handle Unix-format input.
authorCraig A. Berry <craigberry@mac.com>
Sat, 13 Feb 2016 15:47:11 +0000 (09:47 -0600)
committerCraig A. Berry <craigberry@mac.com>
Sat, 13 Feb 2016 15:47:11 +0000 (09:47 -0600)
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.

12 files changed:
dist/PathTools/Cwd.pm
dist/PathTools/lib/File/Spec.pm
dist/PathTools/lib/File/Spec/AmigaOS.pm
dist/PathTools/lib/File/Spec/Cygwin.pm
dist/PathTools/lib/File/Spec/Epoc.pm
dist/PathTools/lib/File/Spec/Functions.pm
dist/PathTools/lib/File/Spec/Mac.pm
dist/PathTools/lib/File/Spec/OS2.pm
dist/PathTools/lib/File/Spec/Unix.pm
dist/PathTools/lib/File/Spec/VMS.pm
dist/PathTools/lib/File/Spec/Win32.pm
dist/PathTools/t/Spec.t

index 9b5183e..e8b9f19 100644 (file)
@@ -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;
 
index 2709c39..32b987e 100644 (file)
@@ -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',
index e6d6f5f..075c36a 100644 (file)
@@ -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);
index 67f056f..2092eb8 100644 (file)
@@ -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);
index 17e3f54..22f0192 100644 (file)
@@ -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;
index 470c771..af2c498 100644 (file)
@@ -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;
index 329451f..52c3bfe 100644 (file)
@@ -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);
index 55e6d33..804ecdb 100644 (file)
@@ -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);
index 586e9b0..3916a11 100644 (file)
@@ -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;
 
index 600c49f..02cc0b0 100644 (file)
@@ -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 );
index 6df7ee8..1105b67 100644 (file)
@@ -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);
index 74c18aa..150c8d4 100644 (file)
@@ -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]'    ],