Assimilate Cwd 2.12 from CPAN. Cwd wasn't in Maintainers, so change

21646 was only applied to core (must punt this back and thereby unfork)
Need to fix test boilerplate properly for PERL_CORE

p4raw-id: //depot/perl@21972

3 files changed, 155 insertions, 6 deletions

diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs
index 4600fefb11..6f8dc9657b 100644
--- a/ext/Cwd/Cwd.xs
+++ b/ext/Cwd/Cwd.xs
@@ -210,6 +210,157 @@ err2:
 #endif
 }
 
+#ifndef getcwd_sv
+// Taken from perl 5.8's util.c
+int getcwd_sv(pTHX_ register SV *sv)
+{
+#ifndef PERL_MICRO
+
+#ifndef INCOMPLETE_TAINTS
+    SvTAINTED_on(sv);
+#endif
+
+#ifdef HAS_GETCWD
+    {
+	char buf[MAXPATHLEN];
+
+	/* Some getcwd()s automatically allocate a buffer of the given
+	 * size from the heap if they are given a NULL buffer pointer.
+	 * The problem is that this behaviour is not portable. */
+	if (getcwd(buf, sizeof(buf) - 1)) {
+	    STRLEN len = strlen(buf);
+	    sv_setpvn(sv, buf, len);
+	    return TRUE;
+	}
+	else {
+	    sv_setsv(sv, &PL_sv_undef);
+	    return FALSE;
+	}
+    }
+
+#else
+
+    Stat_t statbuf;
+    int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
+    int namelen, pathlen=0;
+    DIR *dir;
+    Direntry_t *dp;
+
+    (void)SvUPGRADE(sv, SVt_PV);
+
+    if (PerlLIO_lstat(".", &statbuf) < 0) {
+	SV_CWD_RETURN_UNDEF;
+    }
+
+    orig_cdev = statbuf.st_dev;
+    orig_cino = statbuf.st_ino;
+    cdev = orig_cdev;
+    cino = orig_cino;
+
+    for (;;) {
+	odev = cdev;
+	oino = cino;
+
+	if (PerlDir_chdir("..") < 0) {
+	    SV_CWD_RETURN_UNDEF;
+	}
+	if (PerlLIO_stat(".", &statbuf) < 0) {
+	    SV_CWD_RETURN_UNDEF;
+	}
+
+	cdev = statbuf.st_dev;
+	cino = statbuf.st_ino;
+
+	if (odev == cdev && oino == cino) {
+	    break;
+	}
+	if (!(dir = PerlDir_open("."))) {
+	    SV_CWD_RETURN_UNDEF;
+	}
+
+	while ((dp = PerlDir_read(dir)) != NULL) {
+#ifdef DIRNAMLEN
+	    namelen = dp->d_namlen;
+#else
+	    namelen = strlen(dp->d_name);
+#endif
+	    /* skip . and .. */
+	    if (SV_CWD_ISDOT(dp)) {
+		continue;
+	    }
+
+	    if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
+		SV_CWD_RETURN_UNDEF;
+	    }
+
+	    tdev = statbuf.st_dev;
+	    tino = statbuf.st_ino;
+	    if (tino == oino && tdev == odev) {
+		break;
+	    }
+	}
+
+	if (!dp) {
+	    SV_CWD_RETURN_UNDEF;
+	}
+
+	if (pathlen + namelen + 1 >= MAXPATHLEN) {
+	    SV_CWD_RETURN_UNDEF;
+	}
+
+	SvGROW(sv, pathlen + namelen + 1);
+
+	if (pathlen) {
+	    /* shift down */
+	    Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
+	}
+
+	/* prepend current directory to the front */
+	*SvPVX(sv) = '/';
+	Move(dp->d_name, SvPVX(sv)+1, namelen, char);
+	pathlen += (namelen + 1);
+
+#ifdef VOID_CLOSEDIR
+	PerlDir_close(dir);
+#else
+	if (PerlDir_close(dir) < 0) {
+	    SV_CWD_RETURN_UNDEF;
+	}
+#endif
+    }
+
+    if (pathlen) {
+	SvCUR_set(sv, pathlen);
+	*SvEND(sv) = '\0';
+	SvPOK_only(sv);
+
+	if (PerlDir_chdir(SvPVX(sv)) < 0) {
+	    SV_CWD_RETURN_UNDEF;
+	}
+    }
+    if (PerlLIO_stat(".", &statbuf) < 0) {
+	SV_CWD_RETURN_UNDEF;
+    }
+
+    cdev = statbuf.st_dev;
+    cino = statbuf.st_ino;
+
+    if (cdev != orig_cdev || cino != orig_cino) {
+	Perl_croak(aTHX_ "Unstable directory path, "
+		   "current directory changed unexpectedly");
+    }
+
+    return TRUE;
+#endif
+
+#else
+    return FALSE;
+#endif
+}
+
+#endif
+
+
 MODULE = Cwd		PACKAGE = Cwd
 
 PROTOTYPES: ENABLE
diff --git a/ext/Cwd/t/cwd.t b/ext/Cwd/t/cwd.t
index 514f2b1ac7..92ec184ff0 100644
--- a/ext/Cwd/t/cwd.t
+++ b/ext/Cwd/t/cwd.t
@@ -1,12 +1,11 @@
 #!./perl
 
+use Cwd;
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
 }
 
 use Config;
-use Cwd;
 use strict;
 use warnings;
 use File::Spec;
diff --git a/ext/Cwd/t/taint.t b/ext/Cwd/t/taint.t
index 2cd7d19ae6..9c6748e63a 100644
--- a/ext/Cwd/t/taint.t
+++ b/ext/Cwd/t/taint.t
@@ -1,13 +1,12 @@
 #!./perl -Tw
 # Testing Cwd under taint mode.
 
+use Cwd;
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
 }
 
 use strict;
-use Cwd;
 use Test::More tests => 16;
 use Scalar::Util qw/tainted/;
 
@@ -20,6 +19,6 @@ foreach my $func (@Functions) {
     no strict 'refs';
     my $cwd;
     eval { $cwd = &{'Cwd::'.$func} };
-    is( $@, '',		"$func() does not explode under taint mode" );
-    ok( tainted($cwd),	"its return value is tainted" );
+    is( $@, '',		"$func() should not explode under taint mode" );
+    ok( tainted($cwd),	"its return value should be tainted" );
 }