refactoring normalize in case of second path starting with tilde (~/~foo) - force second path as relative by join (provide normalize flag for TclJoinPath);

test cases extended

2 files changed, 38 insertions, 34 deletions

diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 5c30bcf..c0e8081 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -821,7 +821,7 @@ GetExtension(
  *---------------------------------------------------------------------------
  */
 
-Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);
+Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[], int normalize);
 
 Tcl_Obj *
 Tcl_FSJoinPath(
@@ -829,7 +829,7 @@ Tcl_FSJoinPath(
 				 * reference count. */
     int elements)		/* Number of elements to use (-1 = all) */
 {
-    Tcl_Obj *copy, *res;
+    Tcl_Obj *res;
     int objc;
     Tcl_Obj **objv;
 
@@ -838,17 +838,17 @@ Tcl_FSJoinPath(
     }
 
     elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
-    copy = TclListObjCopy(NULL, listObj);
     Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
-    res = TclJoinPath(elements, objv);
-    Tcl_DecrRefCount(copy);
+    res = TclJoinPath(elements, objv, 0);
     return res;
 }
 
 Tcl_Obj *
 TclJoinPath(
-    int elements,
-    Tcl_Obj * const objv[])
+    int elements,		/* Number of elements to use (-1 = all) */
+    Tcl_Obj * const objv[],	/* Path elements to join */
+    int normalize)		/* 1 if special normalization case (force second
+				 * path relative) */
 {
     Tcl_Obj *res = NULL;	/* Resulting path object (container of join) */
     Tcl_Obj *elt;		/* Path part (result if returns part of path) */
@@ -875,13 +875,14 @@ TclJoinPath(
          * to be an absolute path. Added a check for that elt is absolute.
 	 */
 
-	if ((i == (elements-2)) && (i == 0)
+	if ((i == 0) && (elements == 2)
                 && (elt->typePtr == &tclFsPathType)
 		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
                 && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
             Tcl_Obj *tailObj = objv[i+1];
 
-	    type = TclGetPathType(tailObj, NULL, NULL, NULL);
+	    type = normalize ? TCL_PATH_RELATIVE :
+		    TclGetPathType(tailObj, NULL, NULL, NULL);
 	    if (type == TCL_PATH_RELATIVE) {
 		const char *str;
 		int len;
@@ -953,7 +954,8 @@ TclJoinPath(
 	}
 	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
 	driveNameLength = 0;
-	type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
+	type = (normalize && (i > 0)) ? TCL_PATH_RELATIVE :
+		TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
 	if (type != TCL_PATH_RELATIVE) {
 	    /*
 	     * Zero out the current result.
@@ -2413,37 +2415,30 @@ SetFsPathFromAny(
      * Handle tilde substitutions, if needed.
      */
 
-    if (name[0] == '~') {
+    if (len && name[0] == '~') {
 	char *expandedUser;
 	Tcl_DString temp;
 	int split;
 	char separator = '/';
 
+	/*
+	 * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc.
+	 * split becomes value 1 for '~/...' as well as for '~'.
+	 */
 	split = FindSplitPos(name, separator);
-	if (split != len) {
-	    /*
-	     * We have multiple pieces '~user/foo/bar...'
-	     */
-
-	    name[split] = '\0';
-	}
 
 	/*
 	 * Do some tilde substitution.
 	 */
 
-	if (name[1] == '\0') {
+	if (split == 1) {
 	    /*
-	     * We have just '~'
+	     * We have just '~' (or '~/...')
 	     */
 
 	    const char *dir;
 	    Tcl_DString dirString;
 
-	    if (split != len) {
-		name[split] = separator;
-	    }
-
 	    dir = TclGetEnv("HOME", &dirString);
 	    if (dir == NULL) {
 		if (interp) {
@@ -2461,22 +2456,24 @@ SetFsPathFromAny(
 	     * We have a user name '~user'
 	     */
 
+	    Tcl_DString userName;
+
+	    Tcl_DStringInit(&userName);
+	    Tcl_DStringAppend(&userName, name+1, split-1);
+	    expandedUser = Tcl_DStringValue(&userName);
+
 	    Tcl_DStringInit(&temp);
-	    if (TclpGetUserHome(name+1, &temp) == NULL) {
+	    if (TclpGetUserHome(expandedUser, &temp) == NULL) {
 		if (interp != NULL) {
 		    Tcl_ResetResult(interp);
-		    Tcl_AppendResult(interp, "user \"", name+1,
+		    Tcl_AppendResult(interp, "user \"", expandedUser,
 			    "\" doesn't exist", NULL);
 		}
+		Tcl_DStringFree(&userName);
 		Tcl_DStringFree(&temp);
-		if (split != len) {
-		    name[split] = separator;
-		}
 		return TCL_ERROR;
 	    }
-	    if (split != len) {
-		name[split] = separator;
-	    }
+	    Tcl_DStringFree(&userName);
 	}
 
 	expandedUser = Tcl_DStringValue(&temp);
@@ -2514,7 +2511,7 @@ SetFsPathFromAny(
 
 		pair[0] = transPtr;
 		pair[1] = Tcl_NewStringObj(name+split+1, -1);
-		transPtr = TclJoinPath(2, pair);
+		transPtr = TclJoinPath(2, pair, 1);
 		if (transPtr != pair[0]) {
 		    TclDecrRefCount(pair[0]);
 		}
@@ -2525,7 +2522,7 @@ SetFsPathFromAny(
 	}
 	Tcl_DStringFree(&temp);
     } else {
-	transPtr = TclJoinPath(1, &pathPtr);
+	transPtr = TclJoinPath(1, &pathPtr, 1);
     }
 
     /*
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 6cc8c0f..516505c 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -541,6 +541,13 @@ test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform {
     testsetplatform windows
     file tail {foo\bar}
 } bar
+test cmdAH-9.52 {Tcl_FileObjCmd: tail / normalize, bug 7a9dc52b29} {
+    list \
+	[file tail {~/~foo}] \
+	[file tail {~/test/~foo}] \
+	[file tail [file normalize {~/~foo}]] \
+	[file tail [file normalize {~/test/~foo}]]
+} [lrepeat 4 ./~foo]
 
 # rootname