file normalize bug fixes for .. and .

6 files changed, 112 insertions, 18 deletions

diff --git a/ChangeLog b/ChangeLog
index 6661879..d5252f0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2004-01-22  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* tests/fileSystem.test: 3 new tests
+	* generic/tclPathObj.c: fix to [Bug 879555] in file normalization. 
+	* doc/filename.n: small clarification to Windows behaviour with
+	filenames like '.....', 'a.....', '.....a'.
+	
+	* generic/tclIOUtil.c: slight improvement to native cwd caching
+	on Windows.
+
 2004-01-21  David Gravereaux <davygrvy@pobox.com>
 
 	* doc/Panic.3:  Mentions of 'panic' and 'panicVA' removed from
@@ -36,10 +46,11 @@
 	conversions.  (3) clarifications to the documentation,
 	particularly regarding the acceptable refCounts of objects.
 	Some new tests added.  Tcl benchmarks show a significant
-	improvement over 8.4.5, and typically a small improvement over
-	8.3.5.  TCL_FILESYSTEM_VERSION_2 introduced, but for internal
-	use only.  There should be no public incompatibilities from
-	these changes.  Thanks to dgp for extensive testing.
+	improvement over 8.4.5, and on Windows typically a small
+	improvement over 8.3.5 (Unix still appears to require
+	optimisation).  TCL_FILESYSTEM_VERSION_2 introduced, but for
+	internal use only.  There should be no public incompatibilities
+	from these changes.  Thanks to dgp for extensive testing.
 	
 2004-01-19  David Gravereaux <davygrvy@pobox.com>
 
diff --git a/doc/filename.n b/doc/filename.n
index 5427c1d..28cc55c 100644
--- a/doc/filename.n
+++ b/doc/filename.n
@@ -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: filename.n,v 1.9 2003/12/12 17:02:13 vincentdarley Exp $
+'\" RCS: @(#) $Id: filename.n,v 1.10 2004/01/23 11:03:29 vincentdarley Exp $
 '\" 
 .so man.macros
 .TH filename n 7.5 Tcl "Tcl Built-In Commands"
@@ -216,7 +216,10 @@ to errors in most file operations.
 Another Windows peculiarity is that any number of trailing dots '.'  in
 filenames are totally ignored, so, for example, attempts to create a
 file or directory with a name "foo." will result in the creation of a
-file/directory with name "foo".
+file/directory with name "foo".  This fact is reflected in in the
+results of 'file normalize'.  Furthermore, a file name consisting only
+of dots '.........' or dots with trailing characters '.....abc' is
+illegal.
 .SH KEYWORDS
 current directory, absolute file name, relative file name,
 volume-relative file name, portability
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 738f182..b06885c 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.93 2004/01/21 19:59:33 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.94 2004/01/23 11:03:33 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -2628,13 +2628,40 @@ Tcl_FSChdir(pathPtr)
 	     * will have been cached as a result of the
 	     * Tcl_FSGetFileSystemForPath call above anyway).
 	     */
-	    ClientData cd;
 	    Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
 	    if (normDirName == NULL) {
 	        return TCL_ERROR;
 	    }
-	    cd = (ClientData) Tcl_FSGetNativePath(pathPtr);
-	    FsUpdateCwd(normDirName, TclNativeDupInternalRep(cd));
+	    if (fsPtr == &tclNativeFilesystem) {
+		/* 
+		 * For the native filesystem, we keep a cache of the
+		 * native representation of the cwd.  But, we want to do
+		 * that for the exact format that is returned by
+		 * 'getcwd' (so that we can later compare the two
+		 * representations for equality), which might not be
+		 * exactly the same char-string as the native
+		 * representation of the fully normalized path (e.g. on
+		 * Windows there's a forward-slash vs backslash
+		 * difference).  Hence we ask for this again here.  On
+		 * Unix it might actually be true that we always have
+		 * the correct form in the native rep in which case we
+		 * could simply use:
+		 * 
+		 * cd = Tcl_FSGetNativePath(pathPtr);
+		 * 
+		 * instead.  This should be examined by someone on
+		 * Unix.
+		 */
+		ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+		ClientData cd;
+
+		/* Assumption we are using a filesystem version 2 */
+		TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)fsPtr->getCwdProc;
+		cd = (*proc2)(tsdPtr->cwdClientData);
+		FsUpdateCwd(normDirName, TclNativeDupInternalRep(cd));
+	    } else {
+		FsUpdateCwd(normDirName, NULL);
+	    }
 	}
     } else {
 	Tcl_SetErrno(ENOENT);
@@ -4100,7 +4127,7 @@ ClientData
 TclNativeDupInternalRep(clientData)
     ClientData clientData;
 {
-    ClientData copy;
+    char *copy;
     size_t len;
 
     if (clientData == NULL) {
@@ -4120,9 +4147,9 @@ TclNativeDupInternalRep(clientData)
     len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
 #endif
     
-    copy = (ClientData) ckalloc(len);
+    copy = (char *) ckalloc(len);
     memcpy((VOID*)copy, (VOID*)clientData, len);
-    return copy;
+    return (ClientData)copy;
 }
 
 /*
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index acb16b7..42dfaa3 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.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: tclPathObj.c,v 1.20 2004/01/21 19:59:33 vincentdarley Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.21 2004/01/23 11:04:11 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -216,6 +216,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
 	if (dirSep[1] == '.') {
 	    if (retVal != NULL) {
 		Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep);
+		oldDirSep = dirSep;
 	    }
 	  again:
 	    if (IsSeparatorOrNull(dirSep[2])) {
@@ -226,6 +227,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
 		    Tcl_IncrRefCount(retVal);
 		}
 		dirSep += 2;
+		oldDirSep = dirSep;
 		if (dirSep[0] != 0 && dirSep[1] == '.') {
 		    goto again;
 		}
@@ -269,6 +271,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
 		    }
 		}
 		dirSep += 3;
+		oldDirSep = dirSep;
 		if (dirSep[0] != 0 && dirSep[1] == '.') {
 		    goto again;
 		}
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 69db7f6..112e665 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -296,6 +296,47 @@ if {[tcltest::testConstraint testsetplatform]} {
     testsetplatform $platform
 }
 
+test filesystem-1.34 {file normalisation with '/./'} {
+    set res [file normalize /foo/bar/anc/./.tml]
+    if {[string first "/./" $res] != -1} {
+	set res "normalization of /foo/bar/anc/./.tml is: $res"
+    } else {
+	set res "ok"
+    }
+    set res
+} {ok}
+
+test filesystem-1.35 {file normalisation with '/./'} {
+    set res [file normalize /ffo/bar/anc/./foo/.tml]
+    if {[string first "/./" $res] != -1 || ([regsub -all "foo" $res "" reg] == 2)} {
+	set res "normalization of /ffo/bar/anc/./foo/.tml is: $res"
+    } else {
+	set res "ok"
+    }
+    set res
+} {ok}
+
+test filesystem-1.36 {file normalisation with '/./'} {
+    set res [file normalize /foo/bar/anc/././asdasd/.tml]
+    if {[string first "/./" $res] != -1 || ([regsub -all "asdasd" $res "" reg] == 2) } {
+	set res "normalization of /foo/bar/anc/././asdasd/.tml is: $res"
+    } else {
+	set res "ok"
+    }
+    set res
+} {ok}
+
+test filesystem-1.37 {file normalisation with '/./'} {
+    set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....."
+    set res [file norm $fname]
+    if {[string first "//" $res] != -1} {
+	set res "normalization of $fname is: $res"
+    } else {
+	set res "ok"
+    }
+    set res
+} {ok}
+
 test filesystem-2.0 {new native path} {unixOnly} {
    foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
        catch {file readlink $f}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 12fad95..6a4ddff 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.59 2004/01/21 19:59:34 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.60 2004/01/23 11:06:00 vincentdarley Exp $
  */
 
 //#define _WIN32_WINNT  0x0500
@@ -2433,9 +2433,18 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
 		  && (data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT)) {
 		    Tcl_Obj *to = WinReadLinkDirectory(nativePath);
 		    if (to != NULL) {
-			/* Read the reparse point ok */
-			/* Tcl_GetStringFromObj(to, &pathLen); */
-			nextCheckpoint = 0; /* pathLen */
+			/* 
+			 * Read the reparse point ok.  Now, reparse
+			 * points need not be normalized, otherwise
+			 * we could use: 
+			 * 
+			 * Tcl_GetStringFromObj(to, &pathLen); 
+			 * nextCheckpoint = pathLen
+			 * 
+			 * So, instead we have to start from the
+			 * beginning.
+			 */
+			nextCheckpoint = 0;
 			Tcl_AppendToObj(to, currentPathEndPosition, -1);
 			/* Convert link to forward slashes */
 			for (path = Tcl_GetString(to); *path != 0; path++) {