Change 30133 by [EMAIL PROTECTED] on 2007/02/05 18:05:43
Integrate:
[ 26174]
Upgrade to PathTools-3.14
[ 26318]
Upgrade to PathTools-3.14_01
[ 26319]
Re-instate the old perl getcwd as _perl_getcwd, and use it if loading
the XS fails. (Needed to bootstrap the core build)
[ 26508]
Upgrade to PathTools-3.15
[ 27398]
Upgrade to PathTools-3.17
[ 28001]
Upgrade to Pathtools-3.18
[ 28004]
Added Changes file left out from change #28001.
[ 28511]
Subject: [PATCH] optimisation for File::Spec::abs2rel where both args
are relative
From: Brendan O'Dea <[EMAIL PROTECTED]>
Date: Thu, 6 Jul 2006 01:02:41 +1000
Message-ID: <[EMAIL PROTECTED]>
[ 28551]
Upgrade to PathTools 3.19
[ 28948]
Upgrade to PathTools-3.21
[ 28983]
Update to PathTools-3.22.
[ 29004]
Upgrade to PathTools-3.23.
[ 29356]
Upgrade to PathTools-3.24.
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#305 integrate
... //depot/maint-5.8/perl/ext/Cwd/Changes#11 integrate
... //depot/maint-5.8/perl/ext/Cwd/Cwd.xs#10 integrate
... //depot/maint-5.8/perl/ext/Cwd/t/cwd.t#17 integrate
... //depot/maint-5.8/perl/lib/Cwd.pm#20 integrate
... //depot/maint-5.8/perl/lib/File/Spec.pm#18 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Cygwin.pm#10 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Mac.pm#11 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Unix.pm#19 integrate
... //depot/maint-5.8/perl/lib/File/Spec/VMS.pm#14 integrate
... //depot/maint-5.8/perl/lib/File/Spec/Win32.pm#14 integrate
... //depot/maint-5.8/perl/lib/File/Spec/t/Spec.t#14 integrate
... //depot/maint-5.8/perl/lib/File/Spec/t/crossplatform.t#3 integrate
... //depot/maint-5.8/perl/lib/File/Spec/t/tmpdir.t#1 branch
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#305 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#304~30132~ 2007-02-05 09:37:09.000000000 -0800
+++ perl/MANIFEST 2007-02-05 10:05:43.000000000 -0800
@@ -1486,6 +1486,7 @@
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
==== //depot/maint-5.8/perl/ext/Cwd/Changes#11 (text) ====
Index: perl/ext/Cwd/Changes
--- perl/ext/Cwd/Changes#10~26613~ 2006-01-03 09:24:52.000000000 -0800
+++ perl/ext/Cwd/Changes 2007-02-05 10:05:43.000000000 -0800
@@ -1,5 +1,158 @@
Revision history for Perl distribution PathTools.
+ - Fixed a bug in the $ENV{PWD}-updating of Cwd::chdir() when a
+ dirhandle is passed in. [Steve Peters]
+
+ - Add perl 5.005 to the list of requirements in the
+ Build.PL/Makefile.PL/META.yml.
+
+ - Add ExtUtils::CBuilder to the list of build_requires in Build.PL.
+
+ - Improved performance of canonpath() on Unix-ish platforms - on my
+ OS X laptop it looks like it's about twice as fast. [Ruslan Zakirov]
+
+3.23 - Wed Oct 11 12:11:25 2006
+
+ - Yet more Win32 fixes (sigh... seems like I'm fighting a neverending
+ waterbed...). This time, fixed file_name_is_absolute() to know
+ what it's doing when the path includes a volume but a relative
+ path, like C:foo.txt . This bug had impact in rel2abs() on Win32
+ too.
+
+3.22 - Mon Oct 9 21:50:52 2006
+
+ - Fixed the t/crossplatform.t test on Win32 (and possibly other
+ volume-aware platforms) now that rel2abs() always adds a drive
+ letter. [Reported by several parties]
+
+3.21 - Wed Oct 4 21:16:43 2006
+
+ - Added a bunch of X<> tags to the File::Spec docs to help
+ podindex. [Gabor Szabo]
+
+ - On Win32, abs2rel('C:\one\two\t\foo', 't\bar') should return
+ '..\foo' when the cwd is 'C:\one\two', but it wasn't noticing that
+ the two relevant volumes were the same so it would return the full
+ path 'C:\one\two\t\foo'. This is fixed. [Spotted by Alexandr
+ Ciornii]
+
+ - On Win32, rel2abs() now always adds a volume (drive letter) if the
+ given path doesn't have a volume (drive letter or UNC volume).
+ Previously it could return a value that didn't have a volume if the
+ input was a semi-absolute path like /foo/bar instead of a
+ fully-absolute path like C:/foo/bar .
+
+3.19 Tue Jul 11 22:40:26 CDT 2006
+
+ - When abs2rel() is called with two relative paths
+ (e.g. abs2rel('foo/bar/baz', 'foo/bar')) the resolution algorithm
+ needlessly called cwd() (twice!) to turn both arguments into
+ absolute paths. Now it avoids the cwd() calls with a workaround,
+ making a big efficiency win when abs2rel() is called
+ repeatedly. [Brendan O'Dea]
+
+ - Added a build-time dependency on ExtUtils::Install version 1.39
+ when on Windows. This is necessary because version 1.39 knows how
+ to replace an in-use Cwd shared library, but previous versions
+ don't. [Suggested by Adam Kennedy]
+
+ - Fixed File::Spec::Win32->canonpath('foo/../bar'), which was
+ returning \bar, and now properly returns just bar. [Spotted by
+ Heinrich Tegethoff]
+
+3.18 Thu Apr 27 22:01:38 CDT 2006
+
+ - Fixed some problems on VMS in which a directory called "0" would be
+ treated as a second-class citizen. [Peter (Stig) Edwards]
+
+ - Added a couple of regression tests to make sure abs2rel('/foo/bar',
+ '/') works as expected. [Chia-liang Kao]
+
+ - Added a couple of regression tests to make sure catdir('/',
+ 'foo/bar') works as expected. [Mark Grimes]
+
+3.17 Fri Mar 3 16:52:30 CST 2006
+
+ - The Cygwin version of Cwd::cwd() will croak if given any arguments
+ (which can happen if, for example, it's called as Cwd->cwd). Since
+ that croaking is bad, we now wrap the original cwd() in a
+ subroutine that ignores its arguments. We could skip this wrapping
+ if a future version of perl changes cygwin.c's cwd() to not barf
+ when fed an argument. [Jerry D. Hedden]
+
+3.16 Mon Jan 30 20:48:41 CST 2006
+
+ - Updated to version 3.06 of ppport.h, which provides backward
+ compatibility XS layers for older perl versions.
+
+ - Clarify in the docs for File::Spec's abs2rel() and rel2abs()
+ methods that the cwd() function it discusses is
+ Cwd::cwd(). [Spotted by Steven Lembark]
+
+ - Apparently the version of File::Path that ships with perl 5.8.5
+ (and perhaps others) calls Cwd::getcwd() with an argument (perhaps
+ as a method?), which causes it to die with a prototyping error.
+ We've eliminated the prototype by using the "(...)" arglist, since
+ "PROTOTYPE: DISABLE" for the function didn't seem to work. [Spotted
+ by Eamon Daly and others]
+
+3.15 Tue Dec 27 14:17:39 CST 2005
+
+ - The Cwd::getcwd() function on *nix is now a direct pass-through to
+ the underlying getcwd() C library function when possible. This is
+ safer and faster than the previous implementation, which just did
+ abs_path('.'). The pure-perl version has been kept for cases in
+ which the XS version can't load, such as when running under
+ miniperl. [Suggested by Nick Ing-Simmons]
+
+ - When Cwd searches for a 'pwd' executable in the $PATH, we now stop
+ after we find the first one rather than continuing the search. We
+ also avoid the $PATH search altogether when a 'pwd' was already
+ found in a well-known and well-trusted location like /bin or
+ /usr/bin. [Suggested by Nick Ing-Simmons]
+
+ - On Win32 abs2rel($path, $base) was failing whenever $base is the
+ root of a volume (such as C:\ or \\share\dir). This has been
+ fixed. [Reported by Bryan Daimler]
+
+ - In abs2rel() on VMS, we've fixed handling of directory trees so
+ that the test $file = File::Spec::VMS->abs2rel('[t1.t2.t3]file',
+ '[t1.t2.t3]') returns 'file' instead of an empty string. [John
+ E. Malmberg]
+
+ - In canonpath() on VMS, '[]' was totally optimized away instead of
+ just returning '[]'. Now it's fixed. [John E. Malmberg]
+
+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
==== //depot/maint-5.8/perl/ext/Cwd/Cwd.xs#10 (text) ====
Index: perl/ext/Cwd/Cwd.xs
--- perl/ext/Cwd/Cwd.xs#9~30132~ 2007-02-05 09:37:09.000000000 -0800
+++ perl/ext/Cwd/Cwd.xs 2007-02-05 10:05:43.000000000 -0800
@@ -409,6 +409,19 @@
}
void
+getcwd(...)
+PROTOTYPE: DISABLE
+PPCODE:
+{
+ dXSTARG;
+ getcwd_sv(TARG);
+ XSprePUSH; PUSHTARG;
+#ifndef INCOMPLETE_TAINTS
+ SvTAINTED_on(TARG);
+#endif
+}
+
+void
abs_path(pathsv=Nullsv)
SV *pathsv
PROTOTYPE: DISABLE
==== //depot/maint-5.8/perl/ext/Cwd/t/cwd.t#17 (text) ====
Index: perl/ext/Cwd/t/cwd.t
--- perl/ext/Cwd/t/cwd.t#16~26613~ 2006-01-03 09:24:52.000000000 -0800
+++ perl/ext/Cwd/t/cwd.t 2007-02-05 10:05:43.000000000 -0800
@@ -18,7 +18,7 @@
use Test::More;
require VMS::Filespec if $^O eq 'VMS';
-my $tests = 29;
+my $tests = 30;
# _perl_abs_path() currently only works when the directory separator
# is '/', so don't test it when it won't work.
my $EXTRA_ABSPATH_TESTS = ($Config{prefix} =~ m/\//) && $^O ne 'cygwin';
@@ -125,6 +125,13 @@
dir_ends_with( $result, $Test_Dir, "$func()" );
}
+{
+ # Some versions of File::Path (e.g. that shipped with perl 5.8.5)
+ # call getcwd() with an argument (perhaps by calling it as a
+ # method?), so make sure that doesn't die.
+ is getcwd(), getcwd('foo'), "Call getcwd() with an argument";
+}
+
# Cwd::chdir should also update $ENV{PWD}
dir_ends_with( $ENV{PWD}, $Test_Dir, 'Cwd::chdir() updates $ENV{PWD}' );
my $updir = File::Spec->updir;
==== //depot/maint-5.8/perl/lib/Cwd.pm#20 (text) ====
Index: perl/lib/Cwd.pm
--- perl/lib/Cwd.pm#19~26613~ 2006-01-03 09:24:52.000000000 -0800
+++ perl/lib/Cwd.pm 2007-02-05 10:05:43.000000000 -0800
@@ -35,7 +35,8 @@
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 Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-$VERSION = '3.12';
+$VERSION = '3.24';
@ISA = qw/ Exporter /;
@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -302,6 +303,7 @@
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 @@
# 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;
}
@@ -345,20 +357,26 @@
}
}
+if ($^O eq 'cygwin') {
+ # We need to make sure cwd() is called with no args, because it's
+ # got an arg-less prototype and will die if args are present.
+ local $^W = 0;
+ my $orig_cwd = \&cwd;
+ *cwd = sub { &$orig_cwd() }
+}
+
+
# set a reasonable (and very safe) default for fastgetcwd, in case it
# isn't redefined later (20001212 rspier)
*fastgetcwd = \&cwd;
-# By Brandon S. Allbery
-#
-# Usage: $cwd = getcwd();
-
-sub getcwd
+# A non-XS version of getcwd() - also used to bootstrap the perl build
+# process, when miniperl is running and no XS loading happens.
+sub _perl_getcwd
{
abs_path('.');
}
-
# By John Bazik
#
# Usage: $cwd = &fastcwd;
@@ -461,7 +479,9 @@
return 1;
}
- if ($newdir =~ m#^/#s) {
+ if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
+ $ENV{'PWD'} = cwd();
+ } elsif ($newdir =~ m#^/#s) {
$ENV{'PWD'} = $newdir;
} else {
my @curdir = split(m#/#,$ENV{'PWD'});
@@ -702,6 +722,7 @@
# In case the XS version doesn't load.
*abs_path = \&_perl_abs_path unless defined &abs_path;
+*getcwd = \&_perl_getcwd unless defined &getcwd;
# added function alias for those of us more
# used to the libc function. --tchrist 27-Jan-00
==== //depot/maint-5.8/perl/lib/File/Spec.pm#18 (text) ====
Index: perl/lib/File/Spec.pm
--- perl/lib/File/Spec.pm#17~26613~ 2006-01-03 09:24:52.000000000 -0800
+++ perl/lib/File/Spec.pm 2007-02-05 10:05:43.000000000 -0800
@@ -3,7 +3,7 @@
use strict;
use vars qw(@ISA $VERSION);
-$VERSION = '3.12';
+$VERSION = '3.24';
$VERSION = eval $VERSION;
my %module = (MacOS => 'Mac',
@@ -83,6 +83,7 @@
=over 2
=item canonpath
+X<canonpath>
No physical check on the filesystem, but a logical cleanup of a
path.
@@ -97,6 +98,7 @@
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 @@
$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 @@
$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 @@
$tmpdir = File::Spec->tmpdir();
=item updir
+X<updir>
Returns a string representation of the parent directory.
@@ -172,6 +180,7 @@
(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 @@
@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 @@
(usually identical to) the original path.
=item splitdir
+X<splitdir> X<split, dir>
The opposite of L</catdir()>.
@@ -223,6 +235,7 @@
$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:
@@ -230,10 +243,10 @@
$rel_path = File::Spec->abs2rel( $path ) ;
$rel_path = File::Spec->abs2rel( $path, $base ) ;
-If C<$base> is not present or '', then L<cwd()|Cwd> is used. If C<$base> is
+If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base>
is
relative, then it is converted to absolute form using
L</rel2abs()>. This means that it is taken to be relative to
-L<cwd()|Cwd>.
+L<Cwd::cwd()|Cwd>.
On systems with the concept of volume, if C<$path> and C<$base> appear to be
on two different volumes, we will not attempt to resolve the two
@@ -246,7 +259,7 @@
directories.
If C<$path> is relative, it is converted to absolute form using L</rel2abs()>.
-This means that it is taken to be relative to L<cwd()|Cwd>.
+This means that it is taken to be relative to L<Cwd::cwd()|Cwd>.
No checks against the filesystem are made. On VMS, there is
interaction with the working environment, as logicals and
@@ -255,15 +268,16 @@
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.
$abs_path = File::Spec->rel2abs( $path ) ;
$abs_path = File::Spec->rel2abs( $path, $base ) ;
-If C<$base> is not present or '', then L<cwd()|Cwd> is used. If C<$base> is
relative,
+If C<$base> is not present or '', then L<Cwd::cwd()|Cwd> is used. If C<$base>
is relative,
then it is converted to absolute form using L</rel2abs()>. This means that it
-is taken to be relative to L<cwd()|Cwd>.
+is taken to be relative to L<Cwd::cwd()|Cwd>.
On systems with the concept of volume, if C<$path> and C<$base> appear to be
on two different volumes, we will not attempt to resolve the two
==== //depot/maint-5.8/perl/lib/File/Spec/Cygwin.pm#10 (text) ====
Index: perl/lib/File/Spec/Cygwin.pm
--- perl/lib/File/Spec/Cygwin.pm#9~25376~ 2005-09-10 12:39:28.000000000
-0700
+++ perl/lib/File/Spec/Cygwin.pm 2007-02-05 10:05:43.000000000 -0800
@@ -40,7 +40,25 @@
sub canonpath {
my($self,$path) = @_;
$path =~ s|\\|/|g;
- return $self->SUPER::canonpath($path);
+
+ # Handle network path names beginning with double slash
+ my $node = '';
+ if ( $path =~ [EMAIL PROTECTED](//[^/]+)(?:/|\z)@/@s ) {
+ $node = $1;
+ }
+ return $node . $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
==== //depot/maint-5.8/perl/lib/File/Spec/Unix.pm#19 (text) ====
Index: perl/lib/File/Spec/Unix.pm
--- perl/lib/File/Spec/Unix.pm#18~25376~ 2005-09-10 12:39:28.000000000
-0700
+++ perl/lib/File/Spec/Unix.pm 2007-02-05 10:05:43.000000000 -0800
@@ -43,25 +43,25 @@
my ($self,$path) = @_;
# Handle POSIX-style node names beginning with double slash (qnx, nto)
- # Handle network path names beginning with double slash (cygwin)
# (POSIX says: "a pathname that begins with two successive slashes
# 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 = $^O eq 'qnx' || $^O eq '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
- $path =~ s|/+|/|g; # xx////xx -> xx/xx
- $path =~ s@(/\.)+(/|\Z(?!\n))@/@g; # xx/././xx -> xx/xx
- $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx
- $path =~ s|^/(\.\./)+|/|; # /../../xx -> xx
+ $path =~ s|/{2,}|/|g; # xx////xx -> xx/xx
+ $path =~ s{(?:/\.)+(?:/|\z)}{/}g; # xx/././xx -> xx/xx
+ $path =~ s|^(?:\./)+||s unless $path eq "./"; # ./xx -> xx
+ $path =~ s|^/(?:\.\./)+|/|; # /../../xx -> xx
$path =~ s|^/\.\.$|/|; # /.. -> /
- $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx
+ $path =~ s|/\z|| unless $path eq "/"; # xx/ -> xx
return "$node$path";
}
@@ -179,7 +179,7 @@
sub no_upwards {
my $self = shift;
- return grep(!/^\.{1,2}\Z(?!\n)/s, @_);
+ return grep(!/^\.{1,2}\z/s, @_);
}
=item case_tolerant
@@ -259,7 +259,7 @@
$directory = $path;
}
else {
- $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
+ $path =~ m|^ ( (?: .* / (?: \.\.?\z )? )? ) ([^/]*) |xs;
$directory = $1;
$file = $2;
}
@@ -353,52 +353,57 @@
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 ) ;
+ ($path, $base) = map $self->canonpath($_), $path, $base;
+
+ if (grep $self->file_name_is_absolute($_), $path, $base) {
+ ($path, $base) = map $self->rel2abs($_), $path, $base;
}
else {
- $path = $self->canonpath( $path ) ;
+ # save a couple of cwd()s if both paths are relative
+ ($path, $base) = map $self->catdir('/', $_), $path, $base;
}
- # 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;
+
+ 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);
- my @basechunks = $self->splitdir( $base);
+ 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 && $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()
@@ -483,6 +488,7 @@
my($vol, $dirs, $file) = $fs->splitpath($path);
my @dirs = $fs->splitdir($dirs);
+ pop @dirs if @dirs && $dirs[-1] eq '';
my @collapsed;
foreach my $dir (@dirs) {
==== //depot/maint-5.8/perl/lib/File/Spec/VMS.pm#14 (text) ====
Index: perl/lib/File/Spec/VMS.pm
--- perl/lib/File/Spec/VMS.pm#13~25376~ 2005-09-10 12:39:28.000000000 -0700
+++ perl/lib/File/Spec/VMS.pm 2007-02-05 10:05:43.000000000 -0800
@@ -71,7 +71,7 @@
$path =~ s/\[[^\]\.]+\.-\./\[/g; # [foo.-. ==> [
$path =~ s/\.[^\]\.]+\.-\]/\]/g; # .foo.-] ==> ]
$path =~ s/\[[^\]\.]+\.-\]/\[000000\]/g;# [foo.-] ==> [000000]
- $path =~ s/\[\]//; # [] ==>
+ $path =~ s/\[\]// unless $path eq '[]'; # [] ==>
return $path;
}
}
@@ -85,9 +85,10 @@
=cut
sub catdir {
- my ($self,@dirs) = @_;
- my $dir = pop @dirs;
- @dirs = grep($_,@dirs);
+ my $self = shift;
+ my $dir = pop;
+ my @dirs = grep {defined() && length()} @_;
+
my $rslt;
if (@dirs) {
my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
@@ -118,9 +119,10 @@
=cut
sub catfile {
- my ($self,@files) = @_;
- my $file = $self->canonpath(pop @files);
- @files = grep($_,@files);
+ my $self = shift;
+ my $file = $self->canonpath(pop());
+ my @files = grep {defined() && length()} @_;
+
my $rslt;
if (@files) {
my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
@@ -131,7 +133,7 @@
}
else {
$rslt = $self->eliminate_macros($spath);
- $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
+ $rslt = vmsify($rslt.((defined $rslt) && ($rslt ne '') ? '/' :
'').unixify($file));
}
}
else { $rslt = (defined($file) && length($file)) ? vmsify($file) : ''; }
@@ -335,8 +337,10 @@
# 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 &&
@@ -349,7 +353,13 @@
# @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
) ) ;
}
@@ -417,7 +427,7 @@
# patch the ones in ExtUtils::MM_VMS instead.
sub eliminate_macros {
my($self,$path) = @_;
- return '' unless $path;
+ return '' unless (defined $path) && ($path ne '');
$self = {} unless ref $self;
if ($path =~ /\s/) {
==== //depot/maint-5.8/perl/lib/File/Spec/Win32.pm#14 (text) ====
Index: perl/lib/File/Spec/Win32.pm
--- perl/lib/File/Spec/Win32.pm#13~26613~ 2006-01-03 09:24:52.000000000
-0800
+++ perl/lib/File/Spec/Win32.pm 2007-02-05 10:05:43.000000000 -0800
@@ -9,6 +9,12 @@
@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
@@ -63,7 +69,7 @@
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',
@@ -76,8 +82,18 @@
}
sub file_name_is_absolute {
+ # As of right now, this returns 2 if the path is absolute with a
+ # volume, 1 if it's absolute with no volume, 0 otherwise.
+
my ($self,$file) = @_;
- return scalar($file =~ m{^([a-z]:)?[\\/]}is);
+
+ if ($file =~ m{^($VOL_RX)}o) {
+ my $vol = $1;
+ return ($vol =~ m{^$UNC_RX}o ? 2
+ : $file =~ m{^$DRIVE_RX[\\/]}o ? 2
+ : 0);
+ }
+ return $file =~ m{^[\\/]} ? 1 : 0;
}
=item catfile
@@ -172,21 +188,16 @@
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;
@@ -277,71 +288,47 @@
return $volume ;
}
+sub _same {
+ lc($_[1]) eq lc($_[2]);
+}
-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($_) }
+sub rel2abs {
+ my ($self,$path,$base ) = @_;
- my $path_directories = ($self->splitpath($path, 1))[1];
- my $base_directories = ($self->splitpath($base, 1))[1];
+ my $is_abs = $self->file_name_is_absolute($path);
- # Now, remove all leading components that are the same
- my @pathchunks = $self->splitdir( $path_directories );
- my @basechunks = $self->splitdir( $base_directories );
+ # Check for volume (should probably document the '2' thing...)
+ return $self->canonpath( $path ) if $is_abs == 2;
- while ( @pathchunks &&
- @basechunks &&
- lc( $pathchunks[0] ) eq lc( $basechunks[0] )
- ) {
- shift @pathchunks ;
- shift @basechunks ;
+ if ($is_abs) {
+ # It's missing a volume, add one
+ my $vol = ($self->splitpath( $self->_cwd() ))[0];
+ return $self->canonpath( $vol . $path );
}
- my $result_dirs = $self->catdir( ($self->updir) x @basechunks, @pathchunks
);
-
- return $self->canonpath( $self->catpath('', $result_dirs, '') );
-}
-
+ 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 ) ;
+ }
-sub rel2abs {
- my ($self,$path,$base ) = @_;
+ my ( $path_directories, $path_file ) =
+ ($self->splitpath( $path, 1 ))[1,2] ;
- if ( ! $self->file_name_is_absolute( $path ) ) {
+ my ( $base_volume, $base_directories ) =
+ $self->splitpath( $base, 1 ) ;
- 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
- ) ;
- }
+ $path = $self->catpath(
+ $base_volume,
+ $self->catdir( $base_directories, $path_directories
),
+ $path_file
+ ) ;
return $self->canonpath( $path ) ;
}
==== //depot/maint-5.8/perl/lib/File/Spec/t/Spec.t#14 (text) ====
Index: perl/lib/File/Spec/t/Spec.t
--- perl/lib/File/Spec/t/Spec.t#13~25376~ 2005-09-10 12:39:28.000000000
-0700
+++ perl/lib/File/Spec/t/Spec.t 2007-02-05 10:05:43.000000000 -0800
@@ -90,6 +90,7 @@
[ "Unix->catdir('d1','d2','d3','')", 'd1/d2/d3' ],
[ "Unix->catdir('','d1','d2','d3')", '/d1/d2/d3' ],
[ "Unix->catdir('d1','d2','d3')", 'd1/d2/d3' ],
+[ "Unix->catdir('/','d2/d3')", '/d2/d3' ],
[ "Unix->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ],
[ "Unix->canonpath('')", '' ],
@@ -102,7 +103,7 @@
[ "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' ],
@@ -113,6 +114,10 @@
[ "Unix->abs2rel('/.','/t1/t2/t3')", '../../..' ],
[ "Unix->abs2rel('/./','/t1/t2/t3')", '../../..' ],
#[ "Unix->abs2rel('../t4','/t1/t2/t3')", '../t4' ],
+[ "Unix->abs2rel('/t1/t2/t3', '/')", 't1/t2/t3' ],
+[ "Unix->abs2rel('/t1/t2/t3', '/t1')", 't2/t3' ],
+[ "Unix->abs2rel('t1/t2/t3', 't1')", 't2/t3' ],
+[ "Unix->abs2rel('t1/t2/t3', 't4')", '../t1/t2/t3' ],
[ "Unix->rel2abs('t4','/t1/t2/t3')", '/t1/t2/t3/t4' ],
[ "Unix->rel2abs('t4/t5','/t1/t2/t3')", '/t1/t2/t3/t4/t5' ],
@@ -202,6 +207,7 @@
[ "Win32->catdir('A:/')", 'A:\\' ],
[ "Win32->catdir('\\', 'foo')", '\\foo' ],
+
[ "Win32->catfile('a','b','c')", 'a\\b\\c' ],
[ "Win32->catfile('a','b','.\\c')", 'a\\b\\c' ],
[ "Win32->catfile('.\\a','b','c')", 'a\\b\\c' ],
@@ -232,11 +238,13 @@
[ "Win32->canonpath('\\..\\')", '\\' ],
[ "Win32->canonpath('/../')", '\\' ],
[ "Win32->canonpath('/..\\')", '\\' ],
+[ "Win32->canonpath('d1/../foo')", 'foo' ],
+
[ "Win32->can('_cwd')", '/CODE/' ],
# 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,23 +256,29 @@
[ "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'
],
[ "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->abs2rel('C:\\one\\two\\t\\asd1\\', 't\\asd\\')", '..\\asd1'
],
+[ "FakeWin32->abs2rel('\\one\\two', 'A:\\foo')", 'C:\\one\\two'
],
[ "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' ],
[ "FakeWin32->rel2abs('../','//prague_main/work')",
'\\\\prague_main\\work' ],
+[ "FakeWin32->rel2abs('D:foo.txt')",
'D:\\alpha\\beta\\foo.txt' ],
[ "VMS->case_tolerant()", '1' ],
@@ -274,6 +288,15 @@
[ "VMS->catfile('c')", 'c' ],
[ "VMS->catfile('[]c')", 'c' ],
+[ "VMS->catfile('0','b','c')", '[.0.b]c' ],
+[ "VMS->catfile('a','0','c')", '[.a.0]c' ],
+[ "VMS->catfile('a','b','0')", '[.a.b]0' ],
+[ "VMS->catfile('0','0','c')", '[.0.0]c' ],
+[ "VMS->catfile('a','0','0')", '[.a.0]0' ],
+[ "VMS->catfile('0','b','0')", '[.0.b]0' ],
+[ "VMS->catfile('0','0','0')", '[.0.0]0' ],
+
+
[ "VMS->splitpath('file')", ',,file'
],
[ "VMS->splitpath('[d1.d2.d3]')",
',[d1.d2.d3],' ],
[ "VMS->splitpath('[.d1.d2.d3]')",
',[.d1.d2.d3],' ],
@@ -356,11 +379,11 @@
[ "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 +392,7 @@
[ "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]'
],
@@ -596,12 +619,10 @@
#[ "Epoc->canonpath('/.')", '/' ],
[ "Cygwin->case_tolerant()", '0' ],
+[ "Cygwin->catdir('/','d2/d3')", '/d2/d3' ],
) ;
-if ($^O eq 'MSWin32') {
- push @tests, [ "FakeWin32->rel2abs('D:foo.txt')", 'D:\\alpha\\beta\\foo.txt'
];
-}
plan tests => scalar @tests;
==== //depot/maint-5.8/perl/lib/File/Spec/t/crossplatform.t#3 (text) ====
Index: perl/lib/File/Spec/t/crossplatform.t
--- perl/lib/File/Spec/t/crossplatform.t#2~24144~ 2005-04-03
08:18:11.000000000 -0700
+++ perl/lib/File/Spec/t/crossplatform.t 2007-02-05 10:05:43.000000000
-0800
@@ -39,14 +39,16 @@
my $v = $volumes{$platform} || '';
my $other_v = $other_vols{$platform} || '';
- # Fake out the rootdir on MacOS
+ # Fake out the environment on MacOS and Win32
no strict 'refs';
my $save_w = $^W;
$^W = 0;
local *{"File::Spec::Mac::rootdir"} = sub { "Macintosh HD:" };
+ local *{"File::Spec::Win32::_cwd"} = sub { "C:\\foo" };
$^W = $save_w;
use strict 'refs';
-
+
+
my ($file, $base, $result);
$base = $module->catpath($v, $module->catdir('', 'foo'), '');
@@ -71,15 +73,15 @@
$result = volumes_differ($module, $file, $base) ? $file :
$module->catfile('bar', 'file');
is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file,
$base)";
- # abs2rel('/foo/bar', 'A:/foo') -> '/foo/bar'
+ # abs2rel('/foo/bar/file', 'A:/foo') -> '/foo/bar'
$file = $module->catpath('', $module->catdir($module->rootdir, 'foo',
'bar'), 'file');
$base = $module->catpath($v, $module->catdir($module->rootdir, 'foo'), '');
- $result = volumes_differ($module, $file, $base) ? $file :
$module->catfile('bar', 'file');
+ $result = volumes_differ($module, $file, $base) ? $module->rel2abs($file)
: $module->catfile('bar', 'file');
is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file,
$base)";
# abs2rel('/foo/bar', 'B:/foo') -> '/foo/bar'
$base = $module->catpath($other_v, $module->catdir($module->rootdir,
'foo'), '');
- $result = volumes_differ($module, $file, $base) ? $file :
$module->catfile('bar', 'file');
+ $result = volumes_differ($module, $file, $base) ? $module->rel2abs($file)
: $module->catfile('bar', 'file');
is $module->abs2rel($file, $base), $result, "$platform->abs2rel($file,
$base)";
# abs2rel('/foo/bar', '/foo') -> 'bar'
==== //depot/maint-5.8/perl/lib/File/Spec/t/tmpdir.t#1 (text) ====
Index: perl/lib/File/Spec/t/tmpdir.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/lib/File/Spec/t/tmpdir.t 2007-02-05 10:05:43.000000000 -0800
@@ -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";
End of Patch.
