diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 32 |
2 files changed, 31 insertions, 6 deletions
@@ -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 { |