merge 8.5bug_0e4d88b650

3 files changed, 72 insertions, 86 deletions

diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index e1c5709..6465931 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1805,7 +1805,7 @@ Tcl_FSEvalFileEx(
      * this cross-platform to allow for scripted documents. [Bug: 2040]
      */
 
-    Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
+    Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}");
 
     /*
      * If the encoding is specified, set it for the channel. Else don't touch
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6113f23..25bec6a 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3670,7 +3670,7 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
 
 #define TclUtfToUniChar(str, chPtr) \
 	((((unsigned char) *(str)) < 0xC0) ?		\
-	    ((*(chPtr) = (Tcl_UniChar) *(str)), 1)	\
+	    ((*(chPtr) = (unsigned char) *(str)), 1)	\
 	    : Tcl_UtfToUniChar(str, chPtr))
 
 /*
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 88e49b5..a306853 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -821,50 +821,47 @@ GetExtension(
  *---------------------------------------------------------------------------
  */
 
+Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);
+
 Tcl_Obj *
 Tcl_FSJoinPath(
     Tcl_Obj *listObj,		/* Path elements to join, may have a zero
 				 * reference count. */
     int elements)		/* Number of elements to use (-1 = all) */
 {
-    Tcl_Obj *res;
-    int i;
-    Tcl_Filesystem *fsPtr = NULL;
+    Tcl_Obj *copy, *res;
+    int objc;
+    Tcl_Obj **objv;
 
-    if (elements < 0) {
-	if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
-	    return NULL;
-	}
-    } else {
-	/*
-	 * Just make sure it is a valid list.
-	 */
-
-	int listTest;
-
-	if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
-	    return NULL;
-	}
-
-	/*
-	 * Correct this if it is too large, otherwise we will waste our time
-	 * joining null elements to the path.
-	 */
-
-	if (elements > listTest) {
-	    elements = listTest;
-	}
+    if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) {
+	return NULL;
     }
 
-    res = NULL;
+    elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
+    copy = TclListObjCopy(NULL, listObj);
+    Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
+    res = TclJoinPath(elements, objv);
+    Tcl_DecrRefCount(copy);
+    return res;
+}
+
+Tcl_Obj *
+TclJoinPath(
+    int elements,
+    Tcl_Obj * const objv[])
+{
+    Tcl_Obj *res = NULL;	/* Resulting path object (container of join) */
+    Tcl_Obj *elt;		/* Path part (result if returns part of path) */
+    int i;
+    Tcl_Filesystem *fsPtr = NULL;
 
     for (i = 0; i < elements; i++) {
-	Tcl_Obj *elt, *driveName = NULL;
 	int driveNameLength, strEltLen, length;
 	Tcl_PathType type;
 	char *strElt, *ptr;
-
-	Tcl_ListObjIndex(NULL, listObj, i, &elt);
+	Tcl_Obj *driveName = NULL;
+	
+	elt = objv[i];
 
 	/*
 	 * This is a special case where we can be much more efficient, where
@@ -873,19 +870,23 @@ Tcl_FSJoinPath(
 	 * object which can be normalized more efficiently. Currently we only
 	 * use the special case when we have exactly two elements, but we
 	 * could expand that in the future.
+         *
+         * Bugfix [a47641a0]. TclNewFSPathObj requires first argument
+         * to be an absolute path. Added a check for that elt is absolute.
 	 */
 
-	if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
-		&& !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
-	    Tcl_Obj *tail;
+	if ((i == (elements-2)) && (i == 0)
+                && (elt->typePtr == &tclFsPathType)
+		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
+                && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
+            Tcl_Obj *tailObj = objv[i+1];
 
-	    Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
-	    type = TclGetPathType(tail, NULL, NULL, NULL);
+	    type = TclGetPathType(tailObj, NULL, NULL, NULL);
 	    if (type == TCL_PATH_RELATIVE) {
 		const char *str;
 		int len;
 
-		str = Tcl_GetStringFromObj(tail, &len);
+		str = Tcl_GetStringFromObj(tailObj, &len);
 		if (len == 0) {
 		    /*
 		     * This happens if we try to handle the root volume '/'.
@@ -893,10 +894,7 @@ Tcl_FSJoinPath(
 		     * the base itself is just fine!
 		     */
 
-		    if (res != NULL) {
-			TclDecrRefCount(res);
-		    }
-		    return elt;
+		    goto partReturn; /* return elt; */
 		}
 
 		/*
@@ -917,20 +915,20 @@ Tcl_FSJoinPath(
 		     */
 
 		    if ((tclPlatform != TCL_PLATFORM_WINDOWS)
-			    || (strchr(Tcl_GetString(elt), '\\') == NULL)) {
-			if (res != NULL) {
-			    TclDecrRefCount(res);
-			}
-
+			    || (strchr(Tcl_GetString(elt), '\\') == NULL)
+		    ) {
 			if (PATHFLAGS(elt)) {
-			    return TclNewFSPathObj(elt, str, len);
+			    elt = TclNewFSPathObj(elt, str, len);
+			    goto partReturn; /* return elt; */
 			}
 			if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) {
-			    return TclNewFSPathObj(elt, str, len);
+			    elt = TclNewFSPathObj(elt, str, len);
+			    goto partReturn; /* return elt; */
 			}
 			(void) Tcl_FSGetNormalizedPath(NULL, elt);
 			if (elt == PATHOBJ(elt)->normPathPtr) {
-			    return TclNewFSPathObj(elt, str, len);
+			    elt = TclNewFSPathObj(elt, str, len);
+			    goto partReturn; /* return elt; */
 			}
 		    }
 		}
@@ -940,19 +938,15 @@ Tcl_FSJoinPath(
 		 * more general code below handle things.
 		 */
 	    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
-		if (res != NULL) {
-		    TclDecrRefCount(res);
-		}
-		return tail;
+		elt = tailObj;
+		goto partReturn; /* return elt; */
 	    } else {
-		const char *str = TclGetString(tail);
+		const char *str = TclGetString(tailObj);
 
 		if (tclPlatform == TCL_PLATFORM_WINDOWS) {
 		    if (strchr(str, '\\') == NULL) {
-			if (res != NULL) {
-			    TclDecrRefCount(res);
-			}
-			return tail;
+			elt = tailObj;
+			goto partReturn; /* return elt; */
 		    }
 		}
 	    }
@@ -1031,16 +1025,12 @@ Tcl_FSJoinPath(
 		}
 		ptr++;
 	    }
-	    if (res != NULL) {
-		TclDecrRefCount(res);
-	    }
-
 	    /*
-	     * This element is just what we want to return already - no
-	     * further manipulation is requred.
+	     * This element is just what we want to return already; no further
+	     * manipulation is requred.
 	     */
 
-	    return elt;
+	    goto partReturn; /* return elt; */
 	}
 
 	/*
@@ -1051,10 +1041,8 @@ Tcl_FSJoinPath(
     noQuickReturn:
 	if (res == NULL) {
 	    res = Tcl_NewObj();
-	    ptr = Tcl_GetStringFromObj(res, &length);
-	} else {
-	    ptr = Tcl_GetStringFromObj(res, &length);
 	}
+	ptr = Tcl_GetStringFromObj(res, &length);
 
 	/*
 	 * Strip off any './' before a tilde, unless this is the beginning of
@@ -1083,10 +1071,11 @@ Tcl_FSJoinPath(
 	    int needsSep = 0;
 
 	    if (fsPtr->filesystemSeparatorProc != NULL) {
-		Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
+		Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(res);
 
 		if (sep != NULL) {
 		    separator = TclGetString(sep)[0];
+		    TclDecrRefCount(sep);
 		}
 		/* Safety check in case the VFS driver caused sharing */
 		if (Tcl_IsShared(res)) {
@@ -1126,6 +1115,12 @@ Tcl_FSJoinPath(
 	res = Tcl_NewObj();
     }
     return res;
+
+partReturn:
+    if (res != NULL) {
+	TclDecrRefCount(res);
+    }
+    return elt;
 }
 
 /*
@@ -2516,27 +2511,18 @@ SetFsPathFromAny(
 		}
 		TclDecrRefCount(parts);
 	    } else {
-		/*
-		 * Simple case. "rest" is relative path. Just join it. The
-		 * "rest" object will be freed when Tcl_FSJoinToPath returns
-		 * (unless something else claims a refCount on it).
-		 */
-
-		Tcl_Obj *joined;
-		Tcl_Obj *rest = Tcl_NewStringObj(name+split+1, -1);
+		Tcl_Obj *pair[2];
 
-		Tcl_IncrRefCount(transPtr);
-		joined = Tcl_FSJoinToPath(transPtr, 1, &rest);
-		TclDecrRefCount(transPtr);
-		transPtr = joined;
+		pair[0] = transPtr;
+		pair[1] = Tcl_NewStringObj(name+split+1, -1);
+		transPtr = TclJoinPath(2, pair);
+		TclDecrRefCount(pair[0]);
+		TclDecrRefCount(pair[1]);
 	    }
 	}
 	Tcl_DStringFree(&temp);
     } else {
-	/* Bug 3479689: protect 0-refcount pathPth from getting freed */
-	pathPtr->refCount++;
-	transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL);
-	pathPtr->refCount--;
+	transPtr = TclJoinPath(1, &pathPtr);
     }
 
     /*