Tcl Source Code

Artifact 9f871c7082650dda55563d3eedaec95b693e4367:

Attachment "1379287.patch" to ticket [1379287fff] added by dgp 2006-03-03 11:32:11.

---

Index: generic/tclPathObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclPathObj.c,v
retrieving revision 1.49
diff -u -r1.49 tclPathObj.c
--- generic/tclPathObj.c	12 Jan 2006 18:35:28 -0000	1.49
+++ generic/tclPathObj.c	3 Mar 2006 04:23:29 -0000
@@ -309,12 +309,20 @@
 		     * Either way, we now remove the last path element.
 		     */
 
-		    while (--curLen >= 0) {
+		    while (--curLen > 0) {
 			if (IsSeparatorOrNull(linkStr[curLen])) {
 			    Tcl_SetObjLength(retVal, curLen);
 			    break;
 			}
 		    }
+		    if (curLen == 0) {
+			/* Attempt to .. beyond root becomes root: "/" */
+			if (dirSep[3] != 0) {
+			    Tcl_SetObjLength(retVal, 0);
+			} else {
+			    Tcl_SetObjLength(retVal, 1);
+			}
+		    }
 		}
 		dirSep += 3;
 		oldDirSep = dirSep;
Index: tests/fileSystem.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileSystem.test,v
retrieving revision 1.53
diff -u -r1.53 fileSystem.test
--- tests/fileSystem.test	5 Apr 2005 17:03:22 -0000	1.53
+++ tests/fileSystem.test	3 Mar 2006 04:23:38 -0000
@@ -370,6 +370,76 @@
         set res "ok"
     }
 } {ok}
+test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} {
+    set a [file norm /xxx/..]
+    set b [file norm /]
+    
+    if {![string equal $a $b]} {
+        set res "Paths should be equal: $a , $b"
+    } else {
+        set res "ok"
+    }
+} {ok}
+test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} {
+    set a [file norm /xxx/../]
+    set b [file norm /]
+    
+    if {![string equal $a $b]} {
+        set res "Paths should be equal: $a , $b"
+    } else {
+        set res "ok"
+    }
+} {ok}
+test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} {
+    set a [file norm /xxx/foo/../..]
+    set b [file norm /]
+    
+    if {![string equal $a $b]} {
+        set res "Paths should be equal: $a , $b"
+    } else {
+        set res "ok"
+    }
+} {ok}
+test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} {
+    set a [file norm /xxx/foo/../../]
+    set b [file norm /]
+    
+    if {![string equal $a $b]} {
+        set res "Paths should be equal: $a , $b"
+    } else {
+        set res "ok"
+    }
+} {ok}
+test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} {
+    set a [file norm /xxx/foo/../../bar]
+    set b [file norm /bar]
+    
+    if {![string equal $a $b]} {
+        set res "Paths should be equal: $a , $b"
+    } else {
+        set res "ok"
+    }
+} {ok}
+test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} {
+    set a [file norm /xxx/../../bar]
+    set b [file norm /bar]
+    
+    if {![string equal $a $b]} {
+        set res "Paths should be equal: $a , $b"
+    } else {
+        set res "ok"
+    }
+} {ok}
+test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} {
+    set a [file norm /xxx/../bar]
+    set b [file norm /bar]
+    
+    if {![string equal $a $b]} {
+        set res "Paths should be equal: $a , $b"
+    } else {
+        set res "ok"
+    }
+} {ok}
 
 test filesystem-2.0 {new native path} {unix} {
    foreach f [lsort [glob -nocomplain /usr/bin/c*]] {