From e987f887ebf5997e0c4461c254ec85e39a7b0b46 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 25 Jan 2002 04:27:26 +0000
Subject: 	* Corrected tilde-substitution         of pathnames where > 1
 separator follows the ~.  [Bug 504950]

---
 ChangeLog           |  5 +++++
 generic/tclIOUtil.c | 32 ++++++++++++++++++++++++++------
 2 files changed, 31 insertions(+), 6 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 713857a..524d997 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2002-01-24  Don Porter <dgp@users.sourceforge.net>
+
+	* generic/tclIOUtil.c (SetFsPathFromAny):  Corrected tilde-substitution
+	of pathnames where > 1 separator follows the ~.  [Bug 504950]
+
 2002-01-24  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* library/http/pkgIndex.tcl:
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index adb73c0..0ff5c0a 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.30 2002/01/17 04:37:33 dgp Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.31 2002/01/25 04:27:26 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3538,11 +3538,31 @@ SetFsPathFromAny(interp, objPtr)
 	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 {
-- 
cgit v0.12