diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 11 | ||||
| -rw-r--r-- | tests/fileSystem.test | 24 |
3 files changed, 37 insertions, 4 deletions
@@ -1,3 +1,9 @@ +2003-12-17 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tclPathObj.c: + * tests/fileSystem.test: fix and tests for [Bug 860402] in new + file normalization code. + 2003-12-17 Zoran Vasiljevic <zv@archiware.com> * generic/tclIOUtil.c: fixed 2 memory (object) leaks. diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index db469bc..ae089bc 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.17 2003/12/17 09:25:26 vasiljevic Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.18 2003/12/17 09:55:11 vincentdarley Exp $ */ #include "tclInt.h" @@ -181,7 +181,10 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) */ while (*dirSep != 0) { oldDirSep = dirSep; - dirSep += 1+FindSplitPos(dirSep+1, '/'); + if (!first) { + dirSep++; + } + dirSep += FindSplitPos(dirSep, '/'); if (dirSep[0] == 0 || dirSep[1] == 0) { if (retVal != NULL) { Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep); @@ -216,7 +219,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) retVal = Tcl_NewStringObj(path, dirSep - path); Tcl_IncrRefCount(retVal); } - if (!first) { + if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) { link = Tcl_FSLink(retVal, NULL, 0); if (link != NULL) { /* Got a link */ @@ -236,7 +239,7 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) linkStr = Tcl_GetStringFromObj(retVal, &curLen); } /* Either way, we now remove the last path element */ - while (--curLen > 0) { + while (--curLen >= 0) { if (IsSeparatorOrNull(linkStr[curLen])) { Tcl_SetObjLength(retVal, curLen); break; diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 9301f7d..5063417 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -51,6 +51,11 @@ if {[catch { tcltest::testConstraint hasLinks 1 } +tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]] +if {[tcltest::testConstraint testsetplatform]} { + set platform [testgetplatform] +} + tcltest::testConstraint testsimplefilesystem \ [string equal testsimplefilesystem [info commands testsimplefilesystem]] @@ -258,6 +263,25 @@ test filesystem-1.30 {normalisation of nonexistent user} { list [catch {file normalize ~noonewiththisname} err] $err } {1 {user "noonewiththisname" doesn't exist}} +test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} { + testsetplatform unix + file normalize /foo/../bar +} {/bar} + +test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} { + testsetplatform unix + file normalize /../bar +} {/bar} + +test filesystem-1.33 {link normalisation: link near filesystem root} {testsetplatform} { + testsetplatform windows + file normalize C:/../bar +} {C:/bar} + +if {[tcltest::testConstraint testsetplatform]} { + testsetplatform $platform +} + test filesystem-2.0 {new native path} {unixOnly} { foreach f [lsort [glob -nocomplain /usr/bin/c*]] { catch {file readlink $f} |