further fs cleanup

6 files changed, 48 insertions, 53 deletions

diff --git a/ChangeLog b/ChangeLog
index c195cc4..67b3781 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -18,6 +18,9 @@
 	foreach f [glob *] { # action and/or recursion on $f }
 	cd ..
 
+        * generic/tclTest.c: Fix for [Bug 683181] where test suite
+	left files in 'tmp'.
+	
 2003-02-08  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* library/safe.tcl: code cleanup of eval and string comp use.
diff --git a/doc/FileSystem.3 b/doc/FileSystem.3
index 47a6dd5..dcb92b0 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.31 2003/02/10 10:26:24 vincentdarley Exp $
+'\" RCS: @(#) $Id: FileSystem.3,v 1.32 2003/02/10 12:50:31 vincentdarley Exp $
 '\" 
 .so man.macros
 .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
@@ -856,6 +856,12 @@ its case or other aspects should be made unique).  All other path
 components should be converted from symbolic links.  This one
 exception is required to agree with Tcl's semantics with 'file
 delete', 'file rename', 'file copy' operating on symbolic links.
+This function may be called with 'nextCheckpoint' either
+at the beginning of the path (i.e. zero), at the end of the path, or
+at any intermediate file separator in the path.  It will never
+point to any other arbitrary position in the path. In the last of
+the three valid cases, the implementation can assume that the path 
+up to and including the file separator is known and normalized.
 .PP
 .CS
 typedef int Tcl_FSNormalizePathProc(
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 6c7b9c0..f48876d 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.72 2003/02/10 10:26:25 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.73 2003/02/10 12:50:31 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -3954,10 +3954,9 @@ UpdateStringOfFsPath(objPtr)
 	    break;
 	case TCL_PLATFORM_WINDOWS:
 	    /* 
-	     * We need the cwdLen > 2 because a volume
-	     * relative path doesn't get a '/'.  For
-	     * example 'glob C:*cat*.exe' will return
-	     * 'C:cat32.exe'
+	     * We need the extra 'cwdLen != 2', and ':' checks because 
+	     * a volume relative path doesn't get a '/'.  For example 
+	     * 'glob C:*cat*.exe' will return 'C:cat32.exe'
 	     */
 	    if (cwdStr[cwdLen-1] != '/' 
 	      && cwdStr[cwdLen-1] != '\\') {
@@ -4547,6 +4546,9 @@ Tcl_FSGetTranslatedPath(interp, pathPtr)
     }
     srcFsPathPtr = (FsPath*) pathPtr->internalRep.otherValuePtr;
     if (srcFsPathPtr->translatedPathPtr == NULL) {
+        if (srcFsPathPtr->flags != 0) {
+	    return Tcl_FSGetNormalizedPath(interp, pathPtr);
+        }
         /* 
          * It is a pure absolute, normalized path object.
          * This is something like being a 'pure list'.  The
@@ -4956,43 +4958,6 @@ Tcl_FSGetNativePath(pathObjPtr)
     return (CONST char *)Tcl_FSGetInternalRep(pathObjPtr, &tclNativeFilesystem);
 }
 
-static Tcl_Obj*
-FsGetValidObjRep(interp, objPtr)
-    Tcl_Interp *interp;		/* Interpreter in which to store error
-				 * message (if necessary). */
-    Tcl_Obj *objPtr;		/* Object to convert to a valid, current
-				 * path type. */
-{
-    FsPath *fsPathPtr;
-    if (objPtr->typePtr != &tclFsPathType) {
-	if (Tcl_ConvertToType(interp, objPtr, &tclFsPathType) != TCL_OK) {
-	    return NULL;
-	}
-    }
-    fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
-    
-    if (fsPathPtr->filesystemEpoch != theFilesystemEpoch) {
-	if (objPtr->bytes == NULL) {
-	    UpdateStringOfFsPath(objPtr);
-	}
-	FreeFsPathInternalRep(objPtr);
-	objPtr->typePtr = NULL;
-	if (Tcl_ConvertToType(interp, objPtr, &tclFsPathType) != TCL_OK) {
-	    return NULL;
-	}
-	fsPathPtr = (FsPath*) objPtr->internalRep.otherValuePtr;
-    }
-    
-    if (fsPathPtr->cwdPtr != NULL) {
-	if (FsCwdPointerEquals(fsPathPtr->cwdPtr)) {
-          /* This causes a few minor test failures with links */
-          /* Once these are resolved, this would improve efficiency */
-	  /* return objPtr; */
-	}
-    }
-    return Tcl_FSGetNormalizedPath(interp, objPtr);
-}
-
 /*
  *---------------------------------------------------------------------------
  *
@@ -5019,7 +4984,7 @@ NativeCreateNativeRep(pathObjPtr)
     char *str;
 
     /* Make sure the normalized path is set */
-    validPathObjPtr = FsGetValidObjRep(NULL, pathObjPtr);
+    validPathObjPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
 
     str = Tcl_GetStringFromObj(validPathObjPtr, &len);
 #ifdef __WIN32__
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 91a1caf..1acbcf0 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.59 2003/02/07 11:59:43 vincentdarley Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.60 2003/02/10 12:50:31 vincentdarley Exp $
  */
 
 #define TCL_TEST
@@ -6041,6 +6041,8 @@ SimplePathInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
  * copy without an interp
  */
 static Tcl_Interp *simpleInterpPtr = NULL;
+/* We use this to ensure we clean up after ourselves */
+static Tcl_Obj *tempFile = NULL;
 
 /* 
  * This is a very 'hacky' filesystem which is used just so 
@@ -6085,6 +6087,11 @@ TestSimpleFilesystemObjCmd(dummy, interp, objc, objv)
 	msg = (res == TCL_OK) ? "registered" : "failed";
 	simpleInterpPtr = interp;
     } else {
+	if (tempFile != NULL) {
+	    Tcl_FSDeleteFile(tempFile);
+	    Tcl_DecrRefCount(tempFile);
+	    tempFile = NULL;
+	}
 	res = Tcl_FSUnregister(&simpleFilesystem);
 	msg = (res == TCL_OK) ? "unregistered" : "failed";
 	simpleInterpPtr = NULL;
@@ -6121,6 +6128,7 @@ SimpleCopy(pathPtr)
     Tcl_DecrRefCount(origPtr);
 
     if (res != TCL_OK) {
+	Tcl_FSDeleteFile(tempPtr);
 	Tcl_DecrRefCount(tempPtr);
 	return NULL;
     }
@@ -6153,8 +6161,12 @@ SimpleOpenFileChannel(interp, pathPtr, mode, permissions)
     }
     
     chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions);
-
-    Tcl_DecrRefCount(tempPtr);
+    /* When we are done with this file, it will never be deleted */
+    if (tempFile != NULL) {
+        Tcl_FSDeleteFile(tempFile);
+	Tcl_DecrRefCount(tempFile);
+    }
+    tempFile = tempPtr;
 
     return chan;
 }
@@ -6179,6 +6191,7 @@ SimpleStat(pathPtr, bufPtr)
 	return TCL_OK;
     } else {
 	int res = Tcl_FSStat(tempPtr, bufPtr);
+	Tcl_FSDeleteFile(tempPtr);
 	Tcl_DecrRefCount(tempPtr);
 	return res;
     }
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index a5b6792..bc9746f 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclUnixFCmd.c,v 1.27 2003/02/10 10:26:26 vincentdarley Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.28 2003/02/10 12:50:31 vincentdarley Exp $
  *
  * Portions of this code were derived from NetBSD source code which has
  * the following copyright notice:
@@ -1673,7 +1673,10 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
      * that '/' exists, and if it isn't zero, it must point at
      * a directory separator which we also know exists.
      */
-    currentPathEndPosition = path + nextCheckpoint + 1;
+    currentPathEndPosition = path + nextCheckpoint;
+    if (*currentPathEndPosition == '/') {
+	currentPathEndPosition++;
+    }
 
 #ifndef NO_REALPATH
     /* For speed, try to get the entire path in one go */
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 128e147..8213e6d 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinFile.c,v 1.43 2003/02/10 10:26:26 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.44 2003/02/10 12:50:32 vincentdarley Exp $
  */
 
 //#define _WIN32_WINNT  0x0500
@@ -699,7 +699,6 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 	}
 	return TCL_OK;
     } else {
-	char drivePat[] = "?:\\";
 	DWORD attr;
 	HANDLE handle;
 	WIN32_FIND_DATAT data;
@@ -2026,7 +2025,10 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
 	int isDrive = 1;
 	Tcl_DString ds;
 
-	currentPathEndPosition = path + nextCheckpoint + 1;
+	currentPathEndPosition = path + nextCheckpoint;
+        if (*currentPathEndPosition == '/') {
+	    currentPathEndPosition++;
+        }
 	while (1) {
 	    char cur = *currentPathEndPosition;
 	    if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
@@ -2095,7 +2097,10 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
 	int isDrive = 1;
 	Tcl_DString ds;
 
-	currentPathEndPosition = path + nextCheckpoint + 1;
+	currentPathEndPosition = path + nextCheckpoint;
+	if (*currentPathEndPosition == '/') {
+	    currentPathEndPosition++;
+	}
 	while (1) {
 	    char cur = *currentPathEndPosition;
 	    if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {