Upgrade to PathTools-3.14_01

p4raw-id: //depot/perl@26318

5 files changed, 42 insertions, 20 deletions

diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index d5a6db8ec2..462f262dc7 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -35,7 +35,8 @@ absolute path of the current working directory.
 
 Returns the current working directory.
 
-Re-implements the getcwd(3) (or getwd(3)) functions in Perl.
+Exposes the POSIX function getcwd(3) or re-implements it if it's not
+available.
 
 =item cwd
 
@@ -170,7 +171,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.14';
+$VERSION = '3.14_01';
 
 @ISA = qw/ Exporter /;
 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -302,6 +303,7 @@ foreach my $try ('/bin/pwd',
         last;
     }
 }
+my $found_pwd_cmd = defined($pwd_cmd);
 unless ($pwd_cmd) {
     # Isn't this wrong?  _backtick_pwd() will fail if somenone has
     # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
@@ -334,9 +336,19 @@ unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
     # The pwd command is not available in some chroot(2)'ed environments
     my $sep = $Config::Config{path_sep} || ':';
     my $os = $^O;  # Protect $^O from tainting
-    if( $os eq 'MacOS' || (defined $ENV{PATH} &&
-			   $os ne 'MSWin32' &&  # no pwd on Windows
-			   grep { -x "$_/pwd" } split($sep, $ENV{PATH})) )
+
+
+    # Try again to find a pwd, this time searching the whole PATH.
+    if (defined $ENV{PATH} and $os ne 'MSWin32') {  # no pwd on Windows
+	my @candidates = split($sep, $ENV{PATH});
+	while (!$found_pwd_cmd and @candidates) {
+	    my $candidate = shift @candidates;
+	    $found_pwd_cmd = 1 if -x "$candidate/pwd";
+	}
+    }
+
+    # MacOS has some special magic to make `pwd` work.
+    if( $os eq 'MacOS' || $found_pwd_cmd )
     {
 	*cwd = \&_backtick_pwd;
     }
@@ -349,16 +361,6 @@ unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
 # isn't redefined later (20001212 rspier)
 *fastgetcwd = \&cwd;
 
-# By Brandon S. Allbery
-#
-# Usage: $cwd = getcwd();
-
-sub getcwd
-{
-    abs_path('.');
-}
-
-
 # By John Bazik
 #
 # Usage: $cwd = &fastcwd;
diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm
index 59afacde9e..8f26544e50 100644
--- a/lib/File/Spec.pm
+++ b/lib/File/Spec.pm
@@ -3,7 +3,7 @@ package File::Spec;
 use strict;
 use vars qw(@ISA $VERSION);
 
-$VERSION = '3.14';
+$VERSION = '3.14_01';
 $VERSION = eval $VERSION;
 
 my %module = (MacOS   => 'Mac',
diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm
index 55e6cc30f3..8be7329ffe 100644
--- a/lib/File/Spec/Unix.pm
+++ b/lib/File/Spec/Unix.pm
@@ -369,10 +369,22 @@ sub abs2rel {
     my $path_directories = ($self->splitpath($path, 1))[1];
     my $base_directories = ($self->splitpath($base, 1))[1];
 
+    # For UNC paths, the user might give a volume like //foo/bar that
+    # strictly speaking has no directory portion.  Treat it as if it
+    # had the root directory for that volume.
+    if (!length($base_directories) and $self->file_name_is_absolute($base)) {
+      $base_directories = $self->rootdir;
+    }
+
     # Now, remove all leading components that are the same
     my @pathchunks = $self->splitdir( $path_directories );
     my @basechunks = $self->splitdir( $base_directories );
 
+    if ($base_directories eq $self->rootdir) {
+      shift @pathchunks;
+      return $self->canonpath( $self->catpath('', $self->catdir( @pathchunks ), '') );
+    }
+
     while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
         shift @pathchunks ;
         shift @basechunks ;
diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm
index 58cac1e48c..539a93bcb4 100644
--- a/lib/File/Spec/VMS.pm
+++ b/lib/File/Spec/VMS.pm
@@ -71,7 +71,7 @@ sub canonpath {
 	$path =~ s/\[[^\]\.]+\.-\./\[/g;	# [foo.-.	==> [
 	$path =~ s/\.[^\]\.]+\.-\]/\]/g;	# .foo.-]	==> ]
 	$path =~ s/\[[^\]\.]+\.-\]/\[000000\]/g;# [foo.-]       ==> [000000]
-	$path =~ s/\[\]//;			# []		==>
+	$path =~ s/\[\]// unless $path eq '[]';	# []		==>
 	return $path;
     }
 }
@@ -335,8 +335,10 @@ sub abs2rel {
 
     # Now, remove all leading components that are the same
     my @pathchunks = $self->splitdir( $path_directories );
+    my $pathchunks = @pathchunks;
     unshift(@pathchunks,'000000') unless $pathchunks[0] eq '000000';
     my @basechunks = $self->splitdir( $base_directories );
+    my $basechunks = @basechunks;
     unshift(@basechunks,'000000') unless $basechunks[0] eq '000000';
 
     while ( @pathchunks && 
@@ -347,11 +349,15 @@ sub abs2rel {
         shift @basechunks ;
     }
 
-    return $self->curdir unless @pathchunks || @basechunks;
-
     # @basechunks now contains the directories to climb out of,
     # @pathchunks now has the directories to descend in to.
-    $path_directories = join '.', ('-' x @basechunks, @pathchunks) ;
+    if ((@basechunks > 0) || ($basechunks != $pathchunks)) {
+      $path_directories = join '.', ('-' x @basechunks, @pathchunks) ;
+    }
+    else {
+      $path_directories = join '.', @pathchunks;
+    }
+    $path_directories = '['.$path_directories.']';
     return $self->canonpath( $self->catpath( '', $path_directories, $path_file ) ) ;
 }
 
diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t
index 3fc1f566fb..e7e5b11825 100644
--- a/lib/File/Spec/t/Spec.t
+++ b/lib/File/Spec/t/Spec.t
@@ -255,6 +255,8 @@ if ($^O eq 'MacOS') {
 [ "FakeWin32->abs2rel('A:/t1/t2/t3/t4','B:/t1/t2/t3')",  'A:\\t1\\t2\\t3\\t4' ],
 [ "FakeWin32->abs2rel('E:/foo/bar/baz')",            'E:\\foo\\bar\\baz'      ],
 [ "FakeWin32->abs2rel('C:/one/two/three')",          'three'                  ],
+[ "FakeWin32->abs2rel('C:\\Windows\\System32', 'C:\\')",  'Windows\System32'  ],
+[ "FakeWin32->abs2rel('\\\\computer2\\share3\\foo.txt', '\\\\computer2\\share3')",  'foo.txt' ],
 
 [ "FakeWin32->rel2abs('temp','C:/')",                       'C:\\temp'                        ],
 [ "FakeWin32->rel2abs('temp','C:/a')",                      'C:\\a\\temp'                     ],