Tcl Source Code

Artifact 960a7645b880daad87e0e98f7d7c4c5bd8168da1:

Attachment "2837800-84.patch" to ticket [2837800fff] added by dgp 2009-08-15 03:07:31.

---

Index: generic/tclFileName.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFileName.c,v
retrieving revision 1.40.2.17
diff -u -r1.40.2.17 tclFileName.c
--- generic/tclFileName.c	3 Dec 2008 06:36:05 -0000	1.40.2.17
+++ generic/tclFileName.c	14 Aug 2009 20:06:23 -0000
@@ -2560,15 +2560,21 @@
 					 head, tail, &dirOnly);
 	    *p = save;
 	    if (ret == TCL_OK) {
-		int resLength;
+		int resLength, repair = -1;
 		ret = Tcl_ListObjLength(interp, resultPtr, &resLength);
 		if (ret == TCL_OK) {
 		    int i;
 		    for (i =0; i< resLength; i++) {
 			Tcl_Obj *elt;
 			Tcl_DString ds;
-			Tcl_ListObjIndex(interp, resultPtr, i, &elt);
+			Tcl_ListObjIndex(NULL, resultPtr, i, &elt);
 			Tcl_DStringInit(&ds);
+			if (Tcl_GetString(elt)[0] == '~') {
+			    Tcl_Obj *paths = Tcl_GetObjResult(interp);
+
+			    Tcl_ListObjLength(NULL, paths, &repair);
+			    Tcl_DStringAppend(&ds, "./", 2);
+			}
 			Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1);
 			if(tclPlatform == TCL_PLATFORM_MAC) {
 			    Tcl_DStringAppend(&ds, ":",1);
@@ -2580,6 +2586,24 @@
 			if (ret != TCL_OK) {
 			    break;
 			}
+			if (repair >= 0) {
+			    Tcl_Obj *paths = Tcl_GetObjResult(interp);
+			    int end;
+
+			    Tcl_ListObjLength(NULL, paths, &end);
+			    while (repair < end) {
+				const char *bytes;
+				int numBytes;
+				Tcl_Obj *fixme, *newObj;
+				Tcl_ListObjIndex(NULL, paths, repair, &fixme);
+				bytes = Tcl_GetStringFromObj(fixme, &numBytes);
+				newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
+				Tcl_ListObjReplace(NULL, paths, repair, 1,
+					1, &newObj);
+				repair++;
+			    }
+			    repair = -1;
+			}
 		    }
 		}
 	    }