diff options
Diffstat (limited to 'generic/tclIOUtil.c')
| -rw-r--r-- | generic/tclIOUtil.c | 32 |
1 files changed, 26 insertions, 6 deletions
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 { |