Integrate:

[ 22988]
Upgrade to Cwd 2.17_03

[ 22991]
Upgrade to Cwd 2.18
(with local changes to cwd.t, to adapt it to the core)

[ 22993]
Fix the Cwd tests for the core.
p4raw-link: @22993 on //depot/perl: 39f7733f7d919f26b78bb3c93d85c8b5806102bc
p4raw-link: @22991 on //depot/perl: 7832186692f2b5bb0ae5b8a911736baf4ab3ff87
p4raw-link: @22988 on //depot/perl: 09122b95120d497042cb9df9ebb06ebcfca423aa

p4raw-id: //depot/maint-5.8/perl@23013
p4raw-integrated: from //depot/perl@23012 'copy in' ext/Cwd/t/taint.t
	(@21972..) ext/Cwd/Cwd.xs (@22020..) ext/Cwd/Changes (@22988..)
p4raw-integrated: from //depot/perl@22991 'ignore' ext/Cwd/t/cwd.t
	(@22482..)
p4raw-integrated: from //depot/perl@22988 'ignore' lib/Cwd.pm
	(@22482..)

5 files changed, 235 insertions, 66 deletions

diff --git a/ext/Cwd/Changes b/ext/Cwd/Changes
index ca9684e367..68d85ca748 100644
--- a/ext/Cwd/Changes
+++ b/ext/Cwd/Changes
@@ -1,5 +1,30 @@
 Revision history for Perl extension Cwd.
 
+2.18  Thu Jun 24 08:22:57 CDT 2004
+
+ - Fixed a problem in which abs_path($arg) on some platforms could
+   only be called on directories, and died when called on files.  This
+   was a problem in the pure-perl implementation _perl_abs_path().
+
+ - Fixed fast_abs_path($arg) in the same way as abs_path($arg) above.
+
+ - On Win32, a function getdcwd($vol) has been added, which gets the
+   current working directory of the specified drive/volume.
+   [Steve Hay]
+
+ - Fixed a problem on perl 5.6.2 when built with the MULTIPLICITY
+   compile-time flags. [Yitzchak Scott-Thoennes]
+
+ - When looking for a `pwd` system command, we no longer assume the
+   path separator is ':'.
+
+ - On platforms where cwd() is implemented internally (like Win32),
+   don't look for a `pwd` command externally.  This can greatly speed
+   up load time.  [Stefan Scherer]
+
+ - The pure-perl version of abs_path() now has the same prototype as
+   the XS version (;$).
+
 2.17  Wed Mar 10 07:55:36 CST 2004
 
  - The change in 2.16 created a testing failure when tested from
diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs
index 04ab25eaeb..fae3ef97e3 100644
--- a/ext/Cwd/Cwd.xs
+++ b/ext/Cwd/Cwd.xs
@@ -212,7 +212,8 @@ err2:
 
 #ifndef getcwd_sv
 /* Taken from perl 5.8's util.c */
-int getcwd_sv(pTHX_ register SV *sv)
+#define getcwd_sv(a) Perl_getcwd_sv(aTHX_ a)
+int Perl_getcwd_sv(pTHX_ register SV *sv)
 {
 #ifndef PERL_MICRO
 
@@ -402,3 +403,40 @@ PPCODE:
     SvTAINTED_on(TARG);
 #endif
 }
+
+#ifdef WIN32
+
+void
+getdcwd(...)
+PPCODE:
+{
+    dXSTARG;
+    int drive;
+    char *dir;
+
+    /* Drive 0 is the current drive, 1 is A:, 2 is B:, 3 is C: and so on. */
+    if ( items == 0 ||
+        (items == 1 && (!SvOK(ST(0)) || (SvPOK(ST(0)) && !SvCUR(ST(0))))))
+        drive = 0;
+    else if (items == 1 && SvPOK(ST(0)) && SvCUR(ST(0)) &&
+             isALPHA(SvPVX(ST(0))[0]))
+        drive = toUPPER(SvPVX(ST(0))[0]) - 'A' + 1;
+    else
+        croak("Usage: getdcwd(DRIVE)");
+
+    /* Pass a NULL pointer as the second argument to have space allocated. */
+    if (dir = _getdcwd(drive, NULL, MAXPATHLEN)) {
+        sv_setpvn(TARG, dir, strlen(dir));
+        free(dir);
+        SvPOK_only(TARG);
+    }
+    else
+        sv_setsv(TARG, &PL_sv_undef);
+
+    XSprePUSH; PUSHTARG;
+#ifndef INCOMPLETE_TAINTS
+    SvTAINTED_on(TARG);
+#endif
+}
+
+#endif
diff --git a/ext/Cwd/t/cwd.t b/ext/Cwd/t/cwd.t
index c2142e99f4..816775e6e3 100644
--- a/ext/Cwd/t/cwd.t
+++ b/ext/Cwd/t/cwd.t
@@ -1,9 +1,12 @@
 #!./perl
 
-use Cwd;
 BEGIN {
     chdir 't' if -d 't';
+    if ($ENV{PERL_CORE}) {
+	@INC = '../lib';
+    }
 }
+use Cwd;
 
 use Config;
 use strict;
@@ -11,7 +14,7 @@ use warnings;
 use File::Spec;
 use File::Path;
 
-use Test::More tests => 20;
+use Test::More tests => 24;
 
 my $IsVMS = $^O eq 'VMS';
 my $IsMacOS = $^O eq 'MacOS';
@@ -129,7 +132,7 @@ SKIP: {
     skip "no symlinks on this platform", 2 unless $Config{d_symlink};
 
     mkpath([$Test_Dir], 0, 0777);
-    symlink $Test_Dir => "linktest";
+    symlink $Test_Dir, "linktest";
 
     my $abs_path      =  Cwd::abs_path("linktest");
     my $fast_abs_path =  Cwd::fast_abs_path("linktest");
@@ -142,6 +145,18 @@ SKIP: {
     unlink "linktest";
 }
 
+chdir '../ext/Cwd/t' if $ENV{PERL_CORE};
+
+# Make sure we can run abs_path() on files, not just directories
+my $path = 'cwd.t';
+dir_ends_with(Cwd::abs_path($path), 'cwd.t', 'abs_path() can be invoked on a file');
+dir_ends_with(Cwd::fast_abs_path($path), 'cwd.t', 'fast_abs_path() can be invoked on a file');
+
+$path = File::Spec->catfile(File::Spec->updir, 't', $path);
+dir_ends_with(Cwd::abs_path($path), 'cwd.t', 'abs_path() can be invoked on a file');
+dir_ends_with(Cwd::fast_abs_path($path), 'cwd.t', 'fast_abs_path() can be invoked on a file');
+
+
 #############################################
 # These two routines give us sort of a poor-man's cross-platform
 # directory comparison routine.
diff --git a/ext/Cwd/t/taint.t b/ext/Cwd/t/taint.t
index 9c6748e63a..be0e374510 100644
--- a/ext/Cwd/t/taint.t
+++ b/ext/Cwd/t/taint.t
@@ -1,10 +1,13 @@
 #!./perl -Tw
 # Testing Cwd under taint mode.
 
-use Cwd;
 BEGIN {
     chdir 't' if -d 't';
+    if ($ENV{PERL_CORE}) {
+	@INC = '../lib';
+    }
 }
+use Cwd;
 
 use strict;
 use Test::More tests => 16;
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index 4d5c71e6d6..af0c47f7f1 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -1,5 +1,5 @@
 package Cwd;
-$VERSION = $VERSION = '2.17';
+$VERSION = $VERSION = '2.18';
 
 =head1 NAME
 
@@ -20,7 +20,7 @@ current working directory.  It is recommended that getcwd (or another
 *cwd() function) be used in I<all> code to ensure portability.
 
 By default, it exports the functions cwd(), getcwd(), fastcwd(), and
-fastgetcwd() into the caller's namespace.  
+fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.  
 
 
 =head2 getcwd and friends
@@ -67,6 +67,18 @@ unexpectedly". That should never happen.
 
 The fastgetcwd() function is provided as a synonym for cwd().
 
+=item getdcwd
+
+    my $cwd = getdcwd();
+    my $cwd = getdcwd('C:');
+
+The getdcwd() function is also provided on Win32 to get the current working
+directory on the specified drive, since Windows maintains a separate current
+working directory for each drive.  If no drive is specified then the current
+drive is assumed.
+
+This function simply calls the Microsoft C library _getdcwd() function.
+
 =back
 
 
@@ -134,7 +146,7 @@ C<fast_abs_path()>.
 
 Originally by the perl5-porters.
 
-Now maintained by Ken Williams <KWILLIAMS@cpan.org>
+Maintained by Ken Williams <KWILLIAMS@cpan.org>
 
 =head1 SEE ALSO
 
@@ -148,6 +160,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK);
 
 @ISA = qw/ Exporter /;
 @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
+push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
 @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 
 # sys_cwd may keep the builtin command
@@ -178,6 +191,79 @@ eval {
     XSLoader::load('Cwd');
 };
 
+# Big nasty table of function aliases
+my %METHOD_MAP =
+  (
+   VMS =>
+   {
+    cwd			=> '_vms_cwd',
+    getcwd		=> '_vms_cwd',
+    fastcwd		=> '_vms_cwd',
+    fastgetcwd		=> '_vms_cwd',
+    abs_path		=> '_vms_abs_path',
+    fast_abs_path	=> '_vms_abs_path',
+   },
+
+   MSWin32 =>
+   {
+    # We assume that &_NT_cwd is defined as an XSUB or in the core.
+    cwd			=> '_NT_cwd',
+    getcwd		=> '_NT_cwd',
+    fastcwd		=> '_NT_cwd',
+    fastgetcwd		=> '_NT_cwd',
+    abs_path		=> 'fast_abs_path',
+    realpath		=> 'fast_abs_path',
+   },
+
+   dos => 
+   {
+    cwd			=> '_dos_cwd',
+    getcwd		=> '_dos_cwd',
+    fastgetcwd		=> '_dos_cwd',
+    fastcwd		=> '_dos_cwd',
+    abs_path		=> 'fast_abs_path',
+   },
+
+   qnx =>
+   {
+    cwd			=> '_qnx_cwd',
+    getcwd		=> '_qnx_cwd',
+    fastgetcwd		=> '_qnx_cwd',
+    fastcwd		=> '_qnx_cwd',
+    abs_path		=> '_qnx_abs_path',
+    fast_abs_path	=> '_qnx_abs_path',
+   },
+
+   cygwin =>
+   {
+    getcwd		=> 'cwd',
+    fastgetcwd		=> 'cwd',
+    fastcwd		=> 'cwd',
+    abs_path		=> 'fast_abs_path',
+    realpath		=> 'fast_abs_path',
+   },
+
+   epoc =>
+   {
+    cwd			=> '_epoc_cwd',
+    getcwd	        => '_epoc_cwd',
+    fastgetcwd		=> '_epoc_cwd',
+    fastcwd		=> '_epoc_cwd',
+    abs_path		=> 'fast_abs_path',
+   },
+
+   MacOS =>
+   {
+    getcwd		=> 'cwd',
+    fastgetcwd		=> 'cwd',
+    fastcwd		=> 'cwd',
+    abs_path		=> 'fast_abs_path',
+   },
+  );
+
+$METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
+$METHOD_MAP{nto} = $METHOD_MAP{qnx};
+
 
 # Find the pwd command in the expected locations.  We assume these
 # are safe.  This prevents _backtick_pwd() consulting $ENV{PATH}
@@ -218,10 +304,11 @@ sub _backtick_pwd {
 # Since some ports may predefine cwd internally (e.g., NT)
 # we take care not to override an existing definition for cwd().
 
-unless(defined &cwd) {
+unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
     # The pwd command is not available in some chroot(2)'ed environments
-    if( $^O eq 'MacOS' || (defined $ENV{PATH} && 
-                           grep { -x "$_/pwd" } split(':', $ENV{PATH})) ) 
+    my $sep = $Config::Config{path_sep} || ':';
+    if( $^O eq 'MacOS' || (defined $ENV{PATH} &&
+			   grep { -x "$_/pwd" } split($sep, $ENV{PATH})) )
     {
 	*cwd = \&_backtick_pwd;
     }
@@ -364,7 +451,7 @@ sub chdir {
 
 # In case the XS version doesn't load.
 *abs_path = \&_perl_abs_path unless defined &abs_path;
-sub _perl_abs_path
+sub _perl_abs_path(;$)
 {
     my $start = @_ ? shift : '.';
     my($dotdots, $cwd, @pst, @cst, $dir, @tst);
@@ -374,6 +461,28 @@ sub _perl_abs_path
 	_carp("stat($start): $!");
 	return '';
     }
+
+    unless (-d _) {
+        # Make sure we can be invoked on plain files, not just directories.
+        # NOTE that this routine assumes that '/' is the only directory separator.
+	
+        my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
+	    or return cwd() . '/' . $start;
+	
+	if (-l _) {
+	    my $link_target = readlink($start);
+	    die "Can't resolve link $start: $!" unless defined $link_target;
+	    
+	    require File::Spec;
+            $link_target = $dir . '/' . $link_target
+                unless File::Spec->file_name_is_absolute($link_target);
+	    
+	    return abs_path($link_target);
+	}
+	
+	return abs_path($dir) . '/' . $file;
+    }
+
     $cwd = '';
     $dotdots = $start;
     do
@@ -434,6 +543,29 @@ sub fast_abs_path {
     ($path) = $path =~ /(.*)/;
     ($cwd)  = $cwd  =~ /(.*)/;
 
+    unless (-e $path) {
+ 	_croak("$path: No such file or directory");
+    }
+
+    unless (-d _) {
+        # Make sure we can be invoked on plain files, not just directories.
+	
+	my ($vol, $dir, $file) = File::Spec->splitpath($path);
+	return File::Spec->catfile($cwd, $path) unless length $dir;
+
+	if (-l $path) {
+	    my $link_target = readlink($path);
+	    die "Can't resolve link $path: $!" unless defined $link_target;
+	    
+	    $link_target = File::Spec->catpath($vol, $dir, $link_target)
+                unless File::Spec->file_name_is_absolute($link_target);
+	    
+	    return fast_abs_path($link_target);
+	}
+	
+	return fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
+    }
+
     if (!CORE::chdir($path)) {
  	_croak("Cannot chdir to $path: $!");
     }
@@ -531,61 +663,17 @@ sub _epoc_cwd {
     return $ENV{'PWD'};
 }
 
-{
-    no warnings;	# assignments trigger 'subroutine redefined' warning
 
-    if ($^O eq 'VMS') {
-        *cwd		= \&_vms_cwd;
-        *getcwd		= \&_vms_cwd;
-        *fastcwd	= \&_vms_cwd;
-        *fastgetcwd	= \&_vms_cwd;
-        *abs_path	= \&_vms_abs_path;
-        *fast_abs_path	= \&_vms_abs_path;
-    }
-    elsif ($^O eq 'NT' or $^O eq 'MSWin32') {
-        # We assume that &_NT_cwd is defined as an XSUB or in the core.
-        *cwd		= \&_NT_cwd;
-        *getcwd		= \&_NT_cwd;
-        *fastcwd	= \&_NT_cwd;
-        *fastgetcwd	= \&_NT_cwd;
-        *abs_path	= \&fast_abs_path;
-        *realpath   = \&fast_abs_path;
-    }
-    elsif ($^O eq 'dos') {
-        *cwd		= \&_dos_cwd;
-        *getcwd		= \&_dos_cwd;
-        *fastgetcwd	= \&_dos_cwd;
-        *fastcwd	= \&_dos_cwd;
-        *abs_path	= \&fast_abs_path;
-    }
-    elsif ($^O =~ m/^(?:qnx|nto)$/ ) {
-        *cwd		= \&_qnx_cwd;
-        *getcwd		= \&_qnx_cwd;
-        *fastgetcwd	= \&_qnx_cwd;
-        *fastcwd	= \&_qnx_cwd;
-        *abs_path	= \&_qnx_abs_path;
-        *fast_abs_path	= \&_qnx_abs_path;
-    }
-    elsif ($^O eq 'cygwin') {
-        *getcwd	= \&cwd;
-        *fastgetcwd	= \&cwd;
-        *fastcwd	= \&cwd;
-        *abs_path	= \&fast_abs_path;
-        *realpath	= \&abs_path;
-    }
-    elsif ($^O eq 'epoc') {
-        *cwd            = \&_epoc_cwd;
-        *getcwd	        = \&_epoc_cwd;
-        *fastgetcwd	= \&_epoc_cwd;
-        *fastcwd	= \&_epoc_cwd;
-        *abs_path	= \&fast_abs_path;
-    }
-    elsif ($^O eq 'MacOS') {
-    	*getcwd     = \&cwd;
-    	*fastgetcwd = \&cwd;
-    	*fastcwd    = \&cwd;
-    	*abs_path   = \&fast_abs_path;
-    }
+# Now that all the base-level functions are set up, alias the
+# user-level functions to the right places
+
+if (exists $METHOD_MAP{$^O}) {
+  my $map = $METHOD_MAP{$^O};
+  foreach my $name (keys %$map) {
+    no warnings;	# assignments trigger 'subroutine redefined' warning
+    no strict 'refs';
+    *{$name} = \&{$map->{$name}};
+  }
 }