Tcl Source Code

Artifact [43fd483139]
Login

Artifact 43fd48313906028d5b51041a77bf60f9afc92462:

Attachment "tilde.patch" to ticket [504950ffff] added by dgp 2002-01-24 01:39:55.
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.30
diff -u -u -r1.30 tclIOUtil.c
--- generic/tclIOUtil.c	2002/01/17 04:37:33	1.30
+++ generic/tclIOUtil.c	2002/01/23 18:37:24
@@ -3538,11 +3538,31 @@
 	transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));
 
 	if (split != len) {
-	    /* 
-	     * Join up the tilde substitution with the rest
-	     */
-	    Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1);
-	    transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest);
+	    /* Join up the tilde substitution with the rest */
+	    if (name[split+1] == separator) {
+
+		/*
+		 * Somewhat tricky case like ~//foo/bar.
+		 * Make use of Split/Join machinery to get it right.
+		 * Assumes all paths beginning with ~ are part of the
+		 * native filesystem.
+		 */
+
+		int objc;
+		Tcl_Obj **objv;
+		Tcl_Obj *parts = TclpNativeSplitPath(objPtr, NULL);
+		Tcl_ListObjGetElements(NULL, parts, &objc, &objv);
+		/* Skip '~'.  It's replaced by its expansion */
+		objc--; objv++;
+		while (objc--) {
+		    TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
+		}
+		Tcl_DecrRefCount(parts);
+	    } else {
+		/* Simple case. "rest" is relative path.  Just join it. */
+		Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1);
+		transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest);
+	    }
 	}
 	Tcl_DStringFree(&temp);
     } else {