Upgrade to PathTools-3.14

p4raw-id: //depot/perl@26174

10 files changed, 98 insertions, 80 deletions

diff --git a/MANIFEST b/MANIFEST
index e12b40eae9..7b23b6e433 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1560,6 +1560,7 @@ lib/File/Spec/t/crossplatform.t	See if File::Spec works crossplatform
 lib/File/Spec/t/Functions.t	See if File::Spec::Functions works
 lib/File/Spec/t/rel2abs2rel.t	See if File::Spec->rel2abs/abs2rel works
 lib/File/Spec/t/Spec.t		See if File::Spec works
+lib/File/Spec/t/tmpdir.t	See if File::Spec->tmpdir() works
 lib/File/Spec/Unix.pm		portable operations on Unix file names
 lib/File/Spec/VMS.pm		portable operations on VMS file names
 lib/File/Spec/Win32.pm		portable operations on Win32 and NetWare file names
diff --git a/ext/Cwd/Changes b/ext/Cwd/Changes
index 411e4c4ad0..e104fe56dc 100644
--- a/ext/Cwd/Changes
+++ b/ext/Cwd/Changes
@@ -1,5 +1,35 @@
 Revision history for Perl distribution PathTools.
 
+3.14  Thu Nov 17 18:08:44 CST 2005
+
+ - canonpath() has some logic in it that avoids collapsing a
+   //double/slash at the beginning of a pathname on platforms where
+   that means something special.  It used to check the value of $^O
+   rather than the classname it was called as, which meant that
+   calling File::Spec::Cygwin->canonpath() didn't act like cygwin
+   unless you were actually *on* cygwin.  Now it does.
+
+ - Fixed a major bug on Cygwin in which catdir() could sometimes
+   create things that look like //network/paths in cases when it
+   shouldn't (e.g. catdir("/", "foo", "bar")).
+
+3.13  Tue Nov 15 23:50:37 CST 2005
+
+ - Calling tmpdir() on Win32 had the unintended side-effect of storing
+   some undef values in %INC for the TMPDIR, TEMP, and TMP entries if
+   they didn't exist already.  This is probably a bug in perl itself
+   (submitted as #37441 on rt.perl.org), which we're now working
+   around. [Thomas L. Shinnick]
+
+ - Integrated a change from bleadperl - a certain #ifdef in Cwd.xs
+   needs to apply to WIN32 but not WinCE. [Vadim Konovalov]
+
+ - abs2rel() used to return the empty string when its two arguments
+   were identical, which made no sense.  Now it returns
+   curdir(). [Spotted by David Golden]
+
+ - The Unix and Win32 implementations of abs2rel() have been unified.
+
 3.12  Mon Oct  3 22:09:12 CDT 2005
 
  - Fixed a testing error on OS/2 in which a drive letter for the root
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index 8d25af9f7c..d5a6db8ec2 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -170,7 +170,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.12';
+$VERSION = '3.14';
 
 @ISA = qw/ Exporter /;
 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm
index 0c8cd21e05..59afacde9e 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.12';
+$VERSION = '3.14';
 $VERSION = eval $VERSION;
 
 my %module = (MacOS   => 'Mac',
diff --git a/lib/File/Spec/Cygwin.pm b/lib/File/Spec/Cygwin.pm
index 19a2937c6b..be457b1620 100644
--- a/lib/File/Spec/Cygwin.pm
+++ b/lib/File/Spec/Cygwin.pm
@@ -43,6 +43,18 @@ sub canonpath {
     return $self->SUPER::canonpath($path);
 }
 
+sub catdir {
+    my $self = shift;
+
+    # Don't create something that looks like a //network/path
+    if ($_[0] eq '/' or $_[0] eq '\\') {
+        shift;
+        return $self->SUPER::catdir('', @_);
+    }
+
+    $self->SUPER::catdir(@_);
+}
+
 =pod
 
 =item file_name_is_absolute
diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm
index 4a25fe632f..55e6cc30f3 100644
--- a/lib/File/Spec/Unix.pm
+++ b/lib/File/Spec/Unix.pm
@@ -48,11 +48,12 @@ sub canonpath {
     # may be interpreted in an implementation-defined manner, although
     # more than two leading slashes shall be treated as a single slash.")
     my $node = '';
-    if ( $^O =~ m/^(?:qnx|nto|cygwin)$/ && $path =~ s:^(//[^/]+)(/|\z):/:s ) {
+    my $double_slashes_special = $self->isa("File::Spec::Cygwin") || $^O =~ m/^(?:qnx|nto)$/;
+    if ( $double_slashes_special && $path =~ s:^(//[^/]+)(/|\z):/:s ) {
       $node = $1;
     }
     # This used to be
-    # $path =~ s|/+|/|g unless($^O eq 'cygwin');
+    # $path =~ s|/+|/|g unless ($^O eq 'cygwin');
     # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
     # (Mainly because trailing "" directories didn't get stripped).
     # Why would cygwin avoid collapsing multiple slashes into one? --jhi
@@ -353,52 +354,39 @@ Based on code written by Shigio Yamaguchi.
 
 sub abs2rel {
     my($self,$path,$base) = @_;
+    $base = $self->_cwd() unless defined $base and length $base;
 
-    # Clean up $path
-    if ( ! $self->file_name_is_absolute( $path ) ) {
-        $path = $self->rel2abs( $path ) ;
-    }
-    else {
-        $path = $self->canonpath( $path ) ;
-    }
+    for ($path, $base) { $_ = $self->canonpath($_) }
 
-    # Figure out the effective $base and clean it up.
-    if ( !defined( $base ) || $base eq '' ) {
-        $base = $self->_cwd();
-    }
-    elsif ( ! $self->file_name_is_absolute( $base ) ) {
-        $base = $self->rel2abs( $base ) ;
-    }
-    else {
-        $base = $self->canonpath( $base ) ;
-    }
+    my ($path_volume) = $self->splitpath($path, 1);
+    my ($base_volume) = $self->splitpath($base, 1);
+
+    # Can't relativize across volumes
+    return $path unless $path_volume eq $base_volume;
+
+    for ($path, $base) { $_ = $self->rel2abs($_) }
+
+    my $path_directories = ($self->splitpath($path, 1))[1];
+    my $base_directories = ($self->splitpath($base, 1))[1];
 
     # Now, remove all leading components that are the same
-    my @pathchunks = $self->splitdir( $path);
-    my @basechunks = $self->splitdir( $base);
+    my @pathchunks = $self->splitdir( $path_directories );
+    my @basechunks = $self->splitdir( $base_directories );
 
-    while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
+    while (@pathchunks && @basechunks && $self->_same($pathchunks[0], $basechunks[0])) {
         shift @pathchunks ;
         shift @basechunks ;
     }
-
-    $path = CORE::join( '/', @pathchunks );
-    $base = CORE::join( '/', @basechunks );
+    return $self->curdir unless @pathchunks || @basechunks;
 
     # $base now contains the directories the resulting relative path 
-    # must ascend out of before it can descend to $path_directory.  So, 
-    # replace all names with $parentDir
-    $base =~ s|[^/]+|..|g ;
-
-    # Glue the two together, using a separator if necessary, and preventing an
-    # empty result.
-    if ( $path ne '' && $base ne '' ) {
-        $path = "$base/$path" ;
-    } else {
-        $path = "$base$path" ;
-    }
+    # must ascend out of before it can descend to $path_directory.
+    my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks );
+    return $self->canonpath( $self->catpath('', $result_dirs, '') );
+}
 
-    return $self->canonpath( $path ) ;
+sub _same {
+  $_[1] eq $_[2];
 }
 
 =item rel2abs()
diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm
index f8923f25fb..58cac1e48c 100644
--- a/lib/File/Spec/VMS.pm
+++ b/lib/File/Spec/VMS.pm
@@ -347,6 +347,8 @@ 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) ;
diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm
index a324306a74..6878c83f16 100644
--- a/lib/File/Spec/Win32.pm
+++ b/lib/File/Spec/Win32.pm
@@ -63,7 +63,7 @@ variables are tainted, they are not used.
 my $tmpdir;
 sub tmpdir {
     return $tmpdir if defined $tmpdir;
-    $tmpdir = $_[0]->_tmpdir( @ENV{qw(TMPDIR TEMP TMP)},
+    $tmpdir = $_[0]->_tmpdir( map( $ENV{$_}, qw(TMPDIR TEMP TMP) ),
 			      'SYS:/temp',
 			      'C:\system\temp',
 			      'C:/temp',
@@ -277,42 +277,10 @@ sub catpath {
     return $volume ;
 }
 
-
-sub abs2rel {
-    my($self,$path,$base) = @_;
-    $base = $self->_cwd() unless defined $base and length $base;
-
-    for ($path, $base) { $_ = $self->canonpath($_) }
-
-    my ($path_volume) = $self->splitpath($path, 1);
-    my ($base_volume) = $self->splitpath($base, 1);
-
-    # Can't relativize across volumes
-    return $path unless $path_volume eq $base_volume;
-
-    for ($path, $base) { $_ = $self->rel2abs($_) }
-
-    my $path_directories = ($self->splitpath($path, 1))[1];
-    my $base_directories = ($self->splitpath($base, 1))[1];
-
-    # Now, remove all leading components that are the same
-    my @pathchunks = $self->splitdir( $path_directories );
-    my @basechunks = $self->splitdir( $base_directories );
-
-    while ( @pathchunks && 
-            @basechunks && 
-            lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
-          ) {
-        shift @pathchunks ;
-        shift @basechunks ;
-    }
-
-    my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks );
-
-    return $self->canonpath( $self->catpath('', $result_dirs, '') );
+sub _same {
+  lc($_[1]) eq lc($_[2]);
 }
 
-
 sub rel2abs {
     my ($self,$path,$base ) = @_;
 
diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t
index 02ebde39af..3fc1f566fb 100644
--- a/lib/File/Spec/t/Spec.t
+++ b/lib/File/Spec/t/Spec.t
@@ -102,7 +102,7 @@ if ($^O eq 'MacOS') {
 [ "Unix->canonpath('/../../')",                '/'              ],
 [ "Unix->canonpath('/../..')",                 '/'              ],
 
-[  "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')",          ''                   ],
+[  "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')",          '.'                  ],
 [  "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')",          '../t4'              ],
 [  "Unix->abs2rel('/t1/t2','/t1/t2/t3')",             '..'                 ],
 [  "Unix->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')",       't4'                 ],
@@ -236,7 +236,7 @@ if ($^O eq 'MacOS') {
 
 # FakeWin32 subclass (see below) just sets CWD to C:\one\two and getdcwd('D') to D:\alpha\beta
 
-[ "FakeWin32->abs2rel('/t1/t2/t3','/t1/t2/t3')",     ''                       ],
+[ "FakeWin32->abs2rel('/t1/t2/t3','/t1/t2/t3')",     '.'                      ],
 [ "FakeWin32->abs2rel('/t1/t2/t4','/t1/t2/t3')",     '..\\t4'                 ],
 [ "FakeWin32->abs2rel('/t1/t2','/t1/t2/t3')",        '..'                     ],
 [ "FakeWin32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')",  't4'                     ],
@@ -248,7 +248,7 @@ if ($^O eq 'MacOS') {
 [ "FakeWin32->abs2rel('/./','/t1/t2/t3')",           '..\\..\\..'             ],
 [ "FakeWin32->abs2rel('\\\\a/t1/t2/t4','/t2/t3')",   '\\\\a\\t1\\t2\\t4'      ],
 [ "FakeWin32->abs2rel('//a/t1/t2/t4','/t2/t3')",     '\\\\a\\t1\\t2\\t4'      ],
-[ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3')",     ''                   ],
+[ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3')",     '.'                  ],
 [ "FakeWin32->abs2rel('A:/t1/t2/t3/t4','A:/t1/t2/t3')",  't4'                 ],
 [ "FakeWin32->abs2rel('A:/t1/t2/t3','A:/t1/t2/t3/t4')",  '..'                 ],
 [ "FakeWin32->abs2rel('A:/t1/t2/t3','B:/t1/t2/t3')",     'A:\\t1\\t2\\t3'     ],
@@ -356,11 +356,11 @@ if ($^O eq 'MacOS') {
 [ "VMS->catdir('[.name]')",                                               '[.name]'            ],
 [ "VMS->catdir('[.name]','[.name]')",                                     '[.name.name]'],
 
-[  "VMS->abs2rel('node::volume:[t1.t2.t3]','node::volume:[t1.t2.t3]')", ''                 ],
+[  "VMS->abs2rel('node::volume:[t1.t2.t3]','node::volume:[t1.t2.t3]')", '[]'                 ],
 [  "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", 'node::volume:[t1.t2.t3]'                 ],
 [  "VMS->abs2rel('node::volume:[t1.t2.t4]','node::volume:[t1.t2.t3]')", '[-.t4]'           ],
 [  "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", 'node::volume:[t1.t2.t4]'           ],
-[  "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')",              ''                 ],
+[  "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')",              '[]'               ],
 [  "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')",          'file'             ],
 [  "VMS->abs2rel('[t1.t2.t3]file','[t1.t2]')",             '[.t3]file'        ],
 [  "VMS->abs2rel('v:[t1.t2.t3]file','v:[t1.t2]')",         '[.t3]file'        ],
@@ -369,7 +369,7 @@ if ($^O eq 'MacOS') {
 [  "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')",           '[.t4]'            ],
 [  "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')",              '[---.t4.t5.t6]'   ],
 [ "VMS->abs2rel('[000000]','[t1.t2.t3]')",                 '[---]'            ],
-[ "VMS->abs2rel('a:[t1.t2.t4]','a:[t1.t2.t3]')",             '[-.t4]'           ],
+[ "VMS->abs2rel('a:[t1.t2.t4]','a:[t1.t2.t3]')",           '[-.t4]'           ],
 [ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')",             'a:[t1.t2.t4]'           ],
 [ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')",              '[---.b]'          ],
 
diff --git a/lib/File/Spec/t/tmpdir.t b/lib/File/Spec/t/tmpdir.t
new file mode 100644
index 0000000000..cffa0b0dfa
--- /dev/null
+++ b/lib/File/Spec/t/tmpdir.t
@@ -0,0 +1,17 @@
+use strict;
+use Test;
+
+# Grab all of the plain routines from File::Spec
+use File::Spec;
+use File::Spec::Win32;
+
+plan tests => 3;
+
+ok 1, 1, "Loaded";
+
+my $num_keys = keys %ENV;
+File::Spec->tmpdir;
+ok scalar keys %ENV, $num_keys, "tmpdir() shouldn't change the contents of %ENV";
+
+File::Spec::Win32->tmpdir;
+ok scalar keys %ENV, $num_keys, "Win32->tmpdir() shouldn't change the contents of %ENV";