diff options
| -rw-r--r-- | ChangeLog | 19 | ||||
| -rw-r--r-- | doc/filename.n | 7 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 41 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 5 | ||||
| -rw-r--r-- | tests/fileSystem.test | 41 | ||||
| -rw-r--r-- | win/tclWinFile.c | 17 |
6 files changed, 112 insertions, 18 deletions
@@ -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++) { |