Upgrade to Cwd 2.20

p4raw-id: //depot/perl@23152

4 files changed, 57 insertions, 5 deletions

diff --git a/ext/Cwd/Changes b/ext/Cwd/Changes
index f6974b8161..0b7dd1fbbb 100644
--- a/ext/Cwd/Changes
+++ b/ext/Cwd/Changes
@@ -1,5 +1,18 @@
 Revision history for Perl extension Cwd.
 
+2.20  Thu Jul 22 08:23:53 CDT 2004
+
+ - On some implementations of perl on Win32, a memory leak (or worse?)
+   occurred when calling getdcwd().  This has been fixed. [PodMaster]
+
+ - Added tests for getdcwd() on Win32.
+
+ - Fixed a problem in the pure-perl implementation _perl_abs_path()
+   that caused a fatal error when run on plain files. [Nicholas Clark]
+   To exercise the appropriate test code on platforms that wouldn't
+   otherwise use _perl_abs_path(), run the tests with $ENV{PERL_CORE}
+   or $ENV{TEST_PERL_CWD_CODE} set.
+
 2.19  Thu Jul 15 08:32:18 CDT 2004
 
  - The abs_path($arg) fix from 2.18 didn't work for VMS, now it's
diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs
index fae3ef97e3..273ab2d121 100644
--- a/ext/Cwd/Cwd.xs
+++ b/ext/Cwd/Cwd.xs
@@ -424,10 +424,10 @@ PPCODE:
     else
         croak("Usage: getdcwd(DRIVE)");
 
-    /* Pass a NULL pointer as the second argument to have space allocated. */
-    if (dir = _getdcwd(drive, NULL, MAXPATHLEN)) {
+    New(0,dir,MAXPATHLEN,char);
+    if (_getdcwd(drive, dir, MAXPATHLEN)) {
         sv_setpvn(TARG, dir, strlen(dir));
-        free(dir);
+        Safefree(dir);
         SvPOK_only(TARG);
     }
     else
diff --git a/ext/Cwd/t/cwd.t b/ext/Cwd/t/cwd.t
index 52427e648c..2c7d6c5598 100644
--- a/ext/Cwd/t/cwd.t
+++ b/ext/Cwd/t/cwd.t
@@ -14,7 +14,12 @@ use warnings;
 use File::Spec;
 use File::Path;
 
-use Test::More tests => 24;
+use Test::More;
+
+my $tests = 24;
+my $EXTRA_ABSPATH_TESTS = $ENV{PERL_CORE} || $ENV{TEST_PERL_CWD_CODE};
+$tests += 3 if $EXTRA_ABSPATH_TESTS;
+plan tests => $tests;
 
 my $IsVMS = $^O eq 'VMS';
 my $IsMacOS = $^O eq 'MacOS';
@@ -129,7 +134,7 @@ rmtree($test_dirs[0], 0, 0);
 }
 
 SKIP: {
-    skip "no symlinks on this platform", 2 unless $Config{d_symlink};
+    skip "no symlinks on this platform", 2+$EXTRA_ABSPATH_TESTS unless $Config{d_symlink};
 
     mkpath([$Test_Dir], 0, 0777);
     symlink $Test_Dir, "linktest";
@@ -140,6 +145,7 @@ SKIP: {
 
     like($abs_path,      qr|$want$|);
     like($fast_abs_path, qr|$want$|);
+    like(Cwd::_perl_abs_path("linktest"), qr|$want$|) if $EXTRA_ABSPATH_TESTS;
 
     rmtree($test_dirs[0], 0, 0);
     unlink "linktest";
@@ -154,10 +160,14 @@ if ($ENV{PERL_CORE}) {
 my $path = 'cwd.t';
 path_ends_with(Cwd::abs_path($path), 'cwd.t', 'abs_path() can be invoked on a file');
 path_ends_with(Cwd::fast_abs_path($path), 'cwd.t', 'fast_abs_path() can be invoked on a file');
+path_ends_with(Cwd::_perl_abs_path($path), 'cwd.t', '_perl_abs_path() can be invoked on a file')
+  if $EXTRA_ABSPATH_TESTS;
 
 $path = File::Spec->catfile(File::Spec->updir, 't', $path);
 path_ends_with(Cwd::abs_path($path), 'cwd.t', 'abs_path() can be invoked on a file');
 path_ends_with(Cwd::fast_abs_path($path), 'cwd.t', 'fast_abs_path() can be invoked on a file');
+path_ends_with(Cwd::_perl_abs_path($path), 'cwd.t', '_perl_abs_path() can be invoked on a file')
+  if $EXTRA_ABSPATH_TESTS;
 
 
 #############################################
diff --git a/ext/Cwd/t/win32.t b/ext/Cwd/t/win32.t
new file mode 100644
index 0000000000..f5fa20e102
--- /dev/null
+++ b/ext/Cwd/t/win32.t
@@ -0,0 +1,29 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($ENV{PERL_CORE}) {
+        @INC = '../lib';
+    }
+}
+
+use Test::More;
+if( $^O eq 'MSWin32' ) {
+  plan tests => 3;
+} else {
+  plan skip_all => 'this is not win32';
+}
+
+use Cwd;
+ok 1;
+
+my $cdir = getdcwd('C:');
+like $cdir, qr{^C:};
+
+my $ddir = getdcwd('D:');
+if (defined $ddir) {
+  like $ddir, qr{^D:};
+} else {
+  # May not have a D: drive mounted
+  ok 1;
+}