Upgrade to PathTools-3.21

p4raw-id: //depot/perl@28948

5 files changed, 69 insertions, 42 deletions

diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index 1a85d673f7..1a1fd60877 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -171,7 +171,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.19';
+$VERSION = '3.21';
 
 @ISA = qw/ Exporter /;
 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm
index 60553b5590..df1549c5e2 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.19';
+$VERSION = '3.21';
 $VERSION = eval $VERSION;
 
 my %module = (MacOS   => 'Mac',
@@ -83,6 +83,7 @@ forms of these methods.
 =over 2
 
 =item canonpath
+X<canonpath>
 
 No physical check on the filesystem, but a logical cleanup of a
 path.
@@ -97,6 +98,7 @@ processing, you probably want C<Cwd>'s C<realpath()> function to
 actually traverse the filesystem cleaning up paths like this.
 
 =item catdir
+X<catdir>
 
 Concatenate two or more directory names to form a complete path ending
 with a directory. But remove the trailing slash from the resulting
@@ -107,6 +109,7 @@ trailing slash :-)
     $path = File::Spec->catdir( @directories );
 
 =item catfile
+X<catfile>
 
 Concatenate one or more directory names and a filename to form a
 complete path ending with a filename
@@ -114,24 +117,28 @@ complete path ending with a filename
     $path = File::Spec->catfile( @directories, $filename );
 
 =item curdir
+X<curdir>
 
 Returns a string representation of the current directory.
 
     $curdir = File::Spec->curdir();
 
 =item devnull
+X<devnull>
 
 Returns a string representation of the null device.
 
     $devnull = File::Spec->devnull();
 
 =item rootdir
+X<rootdir>
 
 Returns a string representation of the root directory.
 
     $rootdir = File::Spec->rootdir();
 
 =item tmpdir
+X<tmpdir>
 
 Returns a string representation of the first writable directory from a
 list of possible temporary directories.  Returns the current directory
@@ -142,6 +149,7 @@ checked depends on the platform; e.g. File::Spec::Unix checks C<$ENV{TMPDIR}>
     $tmpdir = File::Spec->tmpdir();
 
 =item updir
+X<updir>
 
 Returns a string representation of the parent directory.
 
@@ -172,6 +180,7 @@ Mac OS (Classic).  It does consult the working environment for VMS
 (see L<File::Spec::VMS/file_name_is_absolute>).
 
 =item path
+X<path>
 
 Takes no argument.  Returns the environment variable C<PATH> (or the local
 platform's equivalent) as a list.
@@ -179,10 +188,12 @@ platform's equivalent) as a list.
     @PATH = File::Spec->path();
 
 =item join
+X<join, path>
 
 join is the same as catfile.
 
 =item splitpath
+X<splitpath> X<split, path>
 
 Splits a path in to volume, directory, and filename portions. On systems
 with no concept of volume, returns '' for volume. 
@@ -201,6 +212,7 @@ The results can be passed to L</catpath()> to get back a path equivalent to
 (usually identical to) the original path.
 
 =item splitdir
+X<splitdir> X<split, dir>
 
 The opposite of L</catdir()>.
 
@@ -223,6 +235,7 @@ inserted if need be.  On other OSes, C<$volume> is significant.
     $full_path = File::Spec->catpath( $volume, $directory, $file );
 
 =item abs2rel
+X<abs2rel> X<absolute, path> X<relative, path>
 
 Takes a destination path and an optional base path returns a relative path
 from the base path to the destination path:
@@ -255,6 +268,7 @@ macros are expanded.
 Based on code written by Shigio Yamaguchi.
 
 =item rel2abs()
+X<rel2abs> X<absolute, path> X<relative, path>
 
 Converts a relative path to an absolute path. 
 
diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm
index 902e14bd3f..18f7652085 100644
--- a/lib/File/Spec/Unix.pm
+++ b/lib/File/Spec/Unix.pm
@@ -358,12 +358,6 @@ sub abs2rel {
 
     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;
-
     if (grep $self->file_name_is_absolute($_), $path, $base) {
 	for ($path, $base) { $_ = $self->rel2abs($_) }
     }
@@ -372,6 +366,12 @@ sub abs2rel {
 	for ($path, $base) { $_ = $self->catdir('/', $_) }
     }
 
+    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;
+
     my $path_directories = ($self->splitpath($path, 1))[1];
     my $base_directories = ($self->splitpath($base, 1))[1];
 
diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm
index 6878c83f16..6251f5380b 100644
--- a/lib/File/Spec/Win32.pm
+++ b/lib/File/Spec/Win32.pm
@@ -9,6 +9,12 @@ $VERSION = '1.6';
 
 @ISA = qw(File::Spec::Unix);
 
+# Some regexes we use for path splitting
+my $DRIVE_RX = '[a-zA-Z]:';
+my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+';
+my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)";
+
+
 =head1 NAME
 
 File::Spec::Win32 - methods for Win32 file specs
@@ -77,7 +83,9 @@ sub case_tolerant {
 
 sub file_name_is_absolute {
     my ($self,$file) = @_;
-    return scalar($file =~ m{^([a-z]:)?[\\/]}is);
+    return $file =~ m{^$VOL_RX}os ? 2 :
+           $file =~   m{^[\\/]}is ? 1 :
+           0;
 }
 
 =item catfile
@@ -172,21 +180,16 @@ sub splitpath {
     my ($volume,$directory,$file) = ('','','');
     if ( $nofile ) {
         $path =~ 
-            m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) 
-                 (.*)
-             }xs;
+            m{^ ( $VOL_RX ? ) (.*) }sox;
         $volume    = $1;
         $directory = $2;
     }
     else {
         $path =~ 
-            m{^ ( (?: [a-zA-Z]: |
-                      (?:\\\\|//)[^\\/]+[\\/][^\\/]+
-                  )?
-                )
+            m{^ ( $VOL_RX ? )
                 ( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
                 (.*)
-             }xs;
+             }sox;
         $volume    = $1;
         $directory = $2;
         $file      = $3;
@@ -284,32 +287,40 @@ sub _same {
 sub rel2abs {
     my ($self,$path,$base ) = @_;
 
-    if ( ! $self->file_name_is_absolute( $path ) ) {
-
-        if ( !defined( $base ) || $base eq '' ) {
-	    require Cwd ;
-	    $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
-	    $base = $self->_cwd() unless defined $base ;
-        }
-        elsif ( ! $self->file_name_is_absolute( $base ) ) {
-            $base = $self->rel2abs( $base ) ;
-        }
-        else {
-            $base = $self->canonpath( $base ) ;
-        }
-
-        my ( $path_directories, $path_file ) =
-            ($self->splitpath( $path, 1 ))[1,2] ;
-
-        my ( $base_volume, $base_directories ) =
-            $self->splitpath( $base, 1 ) ;
-
-        $path = $self->catpath( 
-            $base_volume, 
-            $self->catdir( $base_directories, $path_directories ), 
-            $path_file
-        ) ;
+    my $is_abs = $self->file_name_is_absolute($path);
+
+    # Check for volume (should probably document the '2' thing...)
+    return $self->canonpath( $path ) if $is_abs == 2;
+
+    if ($is_abs) {
+      # It's missing a volume, add one
+      my $vol = ($self->splitpath( $self->_cwd() ))[0];
+      return $self->canonpath( $vol . $path );
+    }
+
+    if ( !defined( $base ) || $base eq '' ) {
+      require Cwd ;
+      $base = Cwd::getdcwd( ($self->splitpath( $path ))[0] ) if defined &Cwd::getdcwd ;
+      $base = $self->_cwd() unless defined $base ;
     }
+    elsif ( ! $self->file_name_is_absolute( $base ) ) {
+      $base = $self->rel2abs( $base ) ;
+    }
+    else {
+      $base = $self->canonpath( $base ) ;
+    }
+
+    my ( $path_directories, $path_file ) =
+      ($self->splitpath( $path, 1 ))[1,2] ;
+
+    my ( $base_volume, $base_directories ) =
+      $self->splitpath( $base, 1 ) ;
+
+    $path = $self->catpath( 
+			   $base_volume, 
+			   $self->catdir( $base_directories, $path_directories ), 
+			   $path_file
+			  ) ;
 
     return $self->canonpath( $path ) ;
 }
diff --git a/lib/File/Spec/t/Spec.t b/lib/File/Spec/t/Spec.t
index bbc54bf86e..32fdb39981 100644
--- a/lib/File/Spec/t/Spec.t
+++ b/lib/File/Spec/t/Spec.t
@@ -265,12 +265,14 @@ if ($^O eq 'MacOS') {
 [ "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->abs2rel('C:\\one\\two\\t\\asd1\\', 't\\asd\\')", '..\\asd1'     ],
 
 [ "FakeWin32->rel2abs('temp','C:/')",                       'C:\\temp'                        ],
 [ "FakeWin32->rel2abs('temp','C:/a')",                      'C:\\a\\temp'                     ],
 [ "FakeWin32->rel2abs('temp','C:/a/')",                     'C:\\a\\temp'                     ],
 [ "FakeWin32->rel2abs('../','C:/')",                        'C:\\'                            ],
 [ "FakeWin32->rel2abs('../','C:/a')",                       'C:\\'                            ],
+[ "FakeWin32->rel2abs('\\foo','C:/a')",                     'C:\\foo'                         ],
 [ "FakeWin32->rel2abs('temp','//prague_main/work/')",       '\\\\prague_main\\work\\temp'     ],
 [ "FakeWin32->rel2abs('../temp','//prague_main/work/')",    '\\\\prague_main\\work\\temp'     ],
 [ "FakeWin32->rel2abs('temp','//prague_main/work')",        '\\\\prague_main\\work\\temp'     ],