summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2003-12-17 09:55:11 (GMT)
committervincentdarley <vincentdarley>2003-12-17 09:55:11 (GMT)
commit55f33bb6ae4422f56b3b765f9b04884287fb3376 (patch)
treef0b0d4db30a39cfa070e26716ca00228c455f387
parentd8e0f63d57a4fe64f5d531d6906be615718944aa (diff)
downloadtcl-55f33bb6ae4422f56b3b765f9b04884287fb3376.zip
tcl-55f33bb6ae4422f56b3b765f9b04884287fb3376.tar.gz
tcl-55f33bb6ae4422f56b3b765f9b04884287fb3376.tar.bz2
fix to fs norm bug 860402
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclPathObj.c11
-rw-r--r--tests/fileSystem.test24
3 files changed, 37 insertions, 4 deletions
diff --git a/ChangeLog b/ChangeLog
index af30220..04e90eb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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}