From 55f33bb6ae4422f56b3b765f9b04884287fb3376 Mon Sep 17 00:00:00 2001
From: vincentdarley <vincentdarley>
Date: Wed, 17 Dec 2003 09:55:11 +0000
Subject: fix to fs norm bug 860402

---
 ChangeLog             |  6 ++++++
 generic/tclPathObj.c  | 11 +++++++----
 tests/fileSystem.test | 24 ++++++++++++++++++++++++
 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}
-- 
cgit v0.12