summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2002-01-25 04:27:26 (GMT)
committerdgp <dgp@users.sourceforge.net>2002-01-25 04:27:26 (GMT)
commite987f887ebf5997e0c4461c254ec85e39a7b0b46 (patch)
tree945b5b1955f46ccdcd8a3d3b86eeaa0fe4d40d77
parent012a69519a5ac4295eb597527e3f465fac7358a3 (diff)
downloadtcl-e987f887ebf5997e0c4461c254ec85e39a7b0b46.zip
tcl-e987f887ebf5997e0c4461c254ec85e39a7b0b46.tar.gz
tcl-e987f887ebf5997e0c4461c254ec85e39a7b0b46.tar.bz2
* Corrected tilde-substitution
of pathnames where > 1 separator follows the ~. [Bug 504950]
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclIOUtil.c32
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 {