summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog19
-rw-r--r--doc/filename.n7
-rw-r--r--generic/tclIOUtil.c41
-rw-r--r--generic/tclPathObj.c5
-rw-r--r--tests/fileSystem.test41
-rw-r--r--win/tclWinFile.c17
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++) {