Tcl Source Code

Artifact 8d07bce19ce90dd81f5ea3101085189797efcb09:

Attachment "fsfix.diff" to ticket [860402ffff] added by vincentdarley 2003-12-17 01:52:40.

---

? fsfix.diff
Index: generic/tclPathObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclPathObj.c,v
retrieving revision 1.16
diff -u -r1.16 tclPathObj.c
--- generic/tclPathObj.c	14 Dec 2003 17:38:37 -0000	1.16
+++ generic/tclPathObj.c	16 Dec 2003 18:52:17 -0000
@@ -181,7 +181,10 @@
      */
     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 @@
 		    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 @@
 			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;
Index: tests/fileSystem.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileSystem.test,v
retrieving revision 1.26
diff -u -r1.26 fileSystem.test
--- tests/fileSystem.test	12 Dec 2003 17:15:23 -0000	1.26
+++ tests/fileSystem.test	16 Dec 2003 18:52:17 -0000
@@ -51,6 +51,11 @@
     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]]
 
@@ -257,6 +262,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*]] {