cd infinite loop bug fixed

4 files changed, 71 insertions, 23 deletions

diff --git a/ChangeLog b/ChangeLog
index 484a11e..2c109ba 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2004-07-17  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* generic/tclIOUtil.c: fix to rare 'cd' infinite loop in
+	normalization with vfs [Bug 991420].
+	* tests/fileSystem.test: added test for above bug.
+
+	* doc/FileSystem.3: clarified documentation of posix error
+	codes in 'remove directory' FS proc - 'EEXIST' is used to
+	signify a non-empty directory error (bug reported against
+	tclvfs).
+
 2004-07-16  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* unix/Makefile.in, unix/tcl.m4:     move (C|LD)FLAGS after their
diff --git a/doc/FileSystem.3 b/doc/FileSystem.3
index 0162c4d..6820c46 100644
--- a/doc/FileSystem.3
+++ b/doc/FileSystem.3
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: FileSystem.3,v 1.43 2004/05/19 16:56:39 vincentdarley Exp $
+'\" RCS: @(#) $Id: FileSystem.3,v 1.44 2004/07/17 12:18:21 vincentdarley Exp $
 '\" 
 .so man.macros
 .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
@@ -1244,10 +1244,11 @@ typedef int Tcl_FSRemoveDirectoryProc(
 The return value is a standard Tcl result indicating whether an error
 occurred in the process.  If successful, the directory specified by
 \fIpathPtr\fR should have been removed from the filesystem.  If the
-\fIrecursive\fR flag is given, then a non-empty directory should
-be deleted without error.  If an error does occur, the name of
-the file or directory which caused the error should be placed in
-\fIerrorPtr\fR.
+\fIrecursive\fR flag is given, then a non-empty directory should be
+deleted without error.  If this flag is not given, then and the
+directory is non-empty a posix EEXIST error should be signalled.  If an
+error does occur, the name of the file or directory which caused the
+error should be placed in \fIerrorPtr\fR.
 .SH DELETEFILEPROC	    
 .PP
 Function to process a \fBTcl_FSDeleteFile()\fR call.  Should be implemented
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index ec493ef..3f1749d 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.106 2004/07/11 21:13:27 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.107 2004/07/17 12:18:22 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -2548,21 +2548,38 @@ Tcl_FSGetCwd(interp)
 			if (retCd != NULL) {
 			    (*fsPtr->freeInternalRepProc)(retCd);
 			}
-		    } else if (Tcl_FSEqualPaths(tsdPtr->cwdPathPtr, norm)) {
+		    } else if (norm == tsdPtr->cwdPathPtr) {
+			goto cdEqual;
+		    } else {
 			/* 
-			 * If the paths were equal, we can be more
-			 * efficient and retain the old path object
-			 * which will probably already be shared.  In
-			 * this case we can simply free the normalized
-			 * path we just calculated.
+			 * Note that both 'norm' and
+			 * 'tsdPtr->cwdPathPtr' are normalized paths.
+			 * Therefore we can be more efficient than
+			 * calling 'Tcl_FSEqualPaths', and in addition
+			 * avoid a nasty infinite loop bug when trying
+			 * to normalize tsdPtr->cwdPathPtr.
 			 */
-			Tcl_DecrRefCount(norm);
-			if (retCd != NULL) {
-			    (*fsPtr->freeInternalRepProc)(retCd);
+			int len1, len2;
+			char *str1, *str2;
+			str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
+			str2 = Tcl_GetStringFromObj(norm, &len2);
+			if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
+			    /* 
+			     * If the paths were equal, we can be more
+			     * efficient and retain the old path object
+			     * which will probably already be shared.  In
+			     * this case we can simply free the normalized
+			     * path we just calculated.
+			     */
+			  cdEqual:
+			    Tcl_DecrRefCount(norm);
+			    if (retCd != NULL) {
+				(*fsPtr->freeInternalRepProc)(retCd);
+			    }
+			} else {
+			    FsUpdateCwd(norm, retCd);
+			    Tcl_DecrRefCount(norm);
 			}
-		    } else {
-			FsUpdateCwd(norm, retCd);
-			Tcl_DecrRefCount(norm);
 		    }
 		    Tcl_DecrRefCount(retVal);
 		} else {
@@ -2658,12 +2675,13 @@ Tcl_FSChdir(pathPtr)
 	 * our private storage of the cwd, since this is the only
 	 * opportunity to do that!
 	 * 
-	 * Note: We used to call this block of code irrespective of
-	 * whether there was a getCwdProc or not, but that led to
-	 * problems with threads.
+	 * Note: We currently call this block of code irrespective of
+	 * whether there was a getCwdProc or not, but the code should
+	 * all in principle work if we only call this block if 
+	 * fsPtr->getCwdProc == NULL.
 	 */
 
-	if (fsPtr->getCwdProc == NULL && retVal == 0) {
+	if (retVal == 0) {
 	    /* 
 	     * Note that this normalized path may be different to what
 	     * we found above (or at least a different object), if the
@@ -2675,7 +2693,8 @@ Tcl_FSChdir(pathPtr)
 	     */
 	    Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
 	    if (normDirName == NULL) {
-		Tcl_SetErrno(ENOENT); /*Not really true, but what else to do?*/
+		/* Not really true, but what else to do? */
+		Tcl_SetErrno(ENOENT); 
 		return -1;
 	    }
 	    if (fsPtr == &tclNativeFilesystem) {
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 172d9d6..fd4918a 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -893,6 +893,23 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} \
 
 removeFile gorp.file
 
+test filesystem-7.8 {vfs cd} {
+    set dir [pwd]
+    cd [tcltest::temporaryDirectory]
+    file delete -force simpledir
+    file mkdir simpledir
+    testsimplefilesystem 1
+    # This can variously cause an infinite loop or simply have
+    # no effect at all (before certain bugs were fixed, of course).
+    cd simplefs:/simpledir
+    set res [pwd]
+    cd [tcltest::temporaryDirectory]
+    testsimplefilesystem 0
+    file delete -force simpledir
+    cd $dir
+    set res
+} {simplefs:/simpledir}
+
 test filesystem-8.1 {relative path objects and caching of pwd} {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]