Tcl Source Code

Artifact [18202f3869]
Login

Artifact 18202f3869a024b0fe994f600a310a0e85ed380b:

Attachment "cdrecursefix.patch" to ticket [845778ffff] added by vincentdarley 2003-11-21 01:44:04.
? cdrecursefix.patch
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1769
diff -u -r1.1769 ChangeLog
--- ChangeLog	20 Nov 2003 18:37:54 -0000	1.1769
+++ ChangeLog	20 Nov 2003 18:42:49 -0000
@@ -1,3 +1,9 @@
+2003-11-20  Vince Darley  <[email protected]>
+
+	* generic/tclPathObj.c:
+	* tests/winFCmd.test: fix to [Bug 845778] - Infinite recursion 
+	on [cd] (Windows only bug).
+	
 2003-11-20  Miguel Sofer <[email protected]>
 
 	* generic/tclVar.c: fix flag bit collision between
Index: generic/tclPathObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclPathObj.c,v
retrieving revision 1.13
diff -u -r1.13 tclPathObj.c
--- generic/tclPathObj.c	3 Nov 2003 12:49:11 -0000	1.13
+++ generic/tclPathObj.c	20 Nov 2003 18:42:56 -0000
@@ -1266,15 +1266,22 @@
 		    }
 		    if (drive[0] == drive_c) {
 			absolutePath = Tcl_DuplicateObj(useThisCwd);
-			Tcl_IncrRefCount(absolutePath);
-			Tcl_AppendToObj(absolutePath, "/", 1);
-			Tcl_AppendToObj(absolutePath, path+2, -1);
 			/* We have a refCount on the cwd */
 		    } else {
-			/* We just can't handle it correctly here */
 			Tcl_DecrRefCount(useThisCwd);
 			useThisCwd = NULL;
+			/* 
+			 * The path is not in the current drive, but
+			 * is volume-relative.  The way Tcl 8.3 handles
+			 * this is that it treats such a path as
+			 * relative to the root of the drive.  We
+			 * therefore behave the same here.
+			 */
+			absolutePath = Tcl_NewStringObj(path, 2);
 		    }
+		    Tcl_IncrRefCount(absolutePath);
+		    Tcl_AppendToObj(absolutePath, "/", 1);
+		    Tcl_AppendToObj(absolutePath, path+2, -1);
 		}
 #endif /* __WIN32__ */
 	    }
Index: tests/winFCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/winFCmd.test,v
retrieving revision 1.23
diff -u -r1.23 winFCmd.test
--- tests/winFCmd.test	14 Nov 2003 20:44:47 -0000	1.23
+++ tests/winFCmd.test	20 Nov 2003 18:42:59 -0000
@@ -1016,12 +1016,21 @@
 test winFCmd-16.9 {Windows file normalization} {pcOnly} {
     file norm /bar/foo
 } "${d}:/bar/foo"
-test winFCmd-16.10 {Windows file normalization} {pcOnly knownBug} {
-    if {$d eq "C"} { set dd "D" } else { set dd "C" }
+if {$d eq "C"} { set dd "D" } else { set dd "C" }
+test winFCmd-16.10 {Windows file normalization} {pcOnly} {
     file norm ${dd}:foo
-} {Tcl doesn't know about a drive-specific cwd}
+} "${dd}:/foo"
+test winFCmd-16.11 {Windows file normalization} {pcOnly cdrom} {
+    cd ${d}:
+    cd $cdrom
+    cd ${d}:
+    cd $cdrom
+    # Must not crash
+    set result "no crash"
+} {no crash}
 
-unset d pwd
+cd $pwd
+unset d dd pwd
 
 # This block of code used to occur after the "return" call, so I'm
 # commenting it out and assuming that this code is still under construction.