1 files changed, 119 insertions, 94 deletions

diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 6d3c013..6452fff 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -147,9 +147,9 @@ FileCopyRename(
 	if ((objc - i) > 2) {
 	    errno = ENOTDIR;
 	    Tcl_PosixError(interp);
-	    Tcl_AppendResult(interp, "error ",
-		    (copyFlag ? "copying" : "renaming"), ": target \"",
-		    TclGetString(target), "\" is not a directory", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error %s: target \"%s\" is not a directory",
+		    (copyFlag?"copying":"renaming"), TclGetString(target)));
 	    result = TCL_ERROR;
 	} else {
 	    /*
@@ -172,7 +172,6 @@ FileCopyRename(
     for ( ; i<objc-1 ; i++) {
 	Tcl_Obj *jargv[2];
 	Tcl_Obj *source, *newFileName;
-	Tcl_Obj *temp;
 
 	source = FileBasename(interp, objv[i]);
 	if (source == NULL) {
@@ -181,13 +180,11 @@ FileCopyRename(
 	}
 	jargv[0] = objv[objc - 1];
 	jargv[1] = source;
-	temp = Tcl_NewListObj(2, jargv);
-	newFileName = Tcl_FSJoinPath(temp, -1);
+	newFileName = TclJoinPath(2, jargv);
 	Tcl_IncrRefCount(newFileName);
 	result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
 		force);
 	Tcl_DecrRefCount(newFileName);
-	Tcl_DecrRefCount(temp);
 	Tcl_DecrRefCount(source);
 
 	if (result == TCL_ERROR) {
@@ -302,8 +299,9 @@ TclFileMakeDirsCmd(
 
   done:
     if (errfile != NULL) {
-	Tcl_AppendResult(interp, "can't create directory \"",
-		TclGetString(errfile), "\": ", Tcl_PosixError(interp), NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create directory \"%s\": %s",
+		TclGetString(errfile), Tcl_PosixError(interp)));
 	result = TCL_ERROR;
     }
     if (split != NULL) {
@@ -382,9 +380,9 @@ TclFileDeleteCmd(
 	    result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
 	    if (result != TCL_OK) {
 		if ((force == 0) && (errno == EEXIST)) {
-		    Tcl_AppendResult(interp, "error deleting \"",
-			    TclGetString(objv[i]), "\": directory not empty",
-			    NULL);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "error deleting \"%s\": directory not empty",
+			    TclGetString(objv[i])));
 		    Tcl_PosixError(interp);
 		    goto done;
 		}
@@ -424,12 +422,13 @@ TclFileDeleteCmd(
 	     * We try to accomodate poor error results from our Tcl_FS calls.
 	     */
 
-	    Tcl_AppendResult(interp, "error deleting unknown file: ",
-		    Tcl_PosixError(interp), NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error deleting unknown file: %s",
+		    Tcl_PosixError(interp)));
 	} else {
-	    Tcl_AppendResult(interp, "error deleting \"",
-		    TclGetString(errfile), "\": ", Tcl_PosixError(interp),
-		    NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error deleting \"%s\": %s",
+		    TclGetString(errfile), Tcl_PosixError(interp)));
 	}
     }
 
@@ -518,7 +517,7 @@ CopyRenameOneFile(
 	 * 16 bits and we get collisions. See bug #2015723.
 	 */
 
-#ifndef WIN32
+#if !defined(_WIN32) && !defined(__CYGWIN__)
 	if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
 	    if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
 		    (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
@@ -538,17 +537,17 @@ CopyRenameOneFile(
 	if (S_ISDIR(sourceStatBuf.st_mode)
 		&& !S_ISDIR(targetStatBuf.st_mode)) {
 	    errno = EISDIR;
-	    Tcl_AppendResult(interp, "can't overwrite file \"",
-		    TclGetString(target), "\" with directory \"",
-		    TclGetString(source), "\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "can't overwrite file \"%s\" with directory \"%s\"",
+		    TclGetString(target), TclGetString(source)));
 	    goto done;
 	}
 	if (!S_ISDIR(sourceStatBuf.st_mode)
 		&& S_ISDIR(targetStatBuf.st_mode)) {
 	    errno = EISDIR;
-	    Tcl_AppendResult(interp, "can't overwrite directory \"",
-		    TclGetString(target), "\" with file \"",
-		    TclGetString(source), "\"", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "can't overwrite directory \"%s\" with file \"%s\"",
+		    TclGetString(target), TclGetString(source)));
 	    goto done;
 	}
 
@@ -579,10 +578,10 @@ CopyRenameOneFile(
 	}
 
 	if (errno == EINVAL) {
-	    Tcl_AppendResult(interp, "error renaming \"",
-		    TclGetString(source), "\" to \"", TclGetString(target),
-		    "\": trying to rename a volume or "
-		    "move a directory into itself", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error renaming \"%s\" to \"%s\": trying to rename a"
+		    " volume or move a directory into itself",
+		    TclGetString(source), TclGetString(target)));
 	    goto done;
 	} else if (errno != EXDEV) {
 	    errfile = target;
@@ -626,8 +625,9 @@ CopyRenameOneFile(
 	     * Actual file doesn't exist.
 	     */
 
-	    Tcl_AppendResult(interp, "error copying \"", TclGetString(source),
-		    "\": the target of this link doesn't exist", NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "error copying \"%s\": the target of this link doesn't"
+		    " exist", TclGetString(source)));
 	    goto done;
 	} else {
 	    int counter = 0;
@@ -734,17 +734,14 @@ CopyRenameOneFile(
 	     */
 
 	    errfile = target;
-
-	    /*
-	     * We now need to reset the result, because the above call, if it
-	     * failed, may have put an error message in place. (Ideally we
-	     * would prefer not to pass an interpreter in above, but the
-	     * channel IO code used by TclCrossFilesystemCopy currently
-	     * requires one).
-	     */
-
-	    Tcl_ResetResult(interp);
 	}
+	/* 
+	 * We now need to reset the result, because the above call,
+	 * may have left set it.  (Ideally we would prefer not to pass
+	 * an interpreter in above, but the channel IO code used by
+	 * TclCrossFilesystemCopy currently requires one)
+	 */
+	Tcl_ResetResult(interp);
     }
     if ((copyFlag == 0) && (result == TCL_OK)) {
 	if (S_ISDIR(sourceStatBuf.st_mode)) {
@@ -762,23 +759,27 @@ CopyRenameOneFile(
 	    }
 	}
 	if (result != TCL_OK) {
-	    Tcl_AppendResult(interp, "can't unlink \"", TclGetString(errfile),
-		    "\": ", Tcl_PosixError(interp), NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't unlink \"%s\": %s",
+		    TclGetString(errfile), Tcl_PosixError(interp)));
 	    errfile = NULL;
 	}
     }
 
   done:
     if (errfile != NULL) {
-	Tcl_AppendResult(interp, "error ", (copyFlag ? "copying" : "renaming"),
-		 " \"", TclGetString(source), NULL);
+	Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"",
+		(copyFlag ? "copying" : "renaming"), TclGetString(source));
+
 	if (errfile != source) {
-	    Tcl_AppendResult(interp, "\" to \"", TclGetString(target), NULL);
+	    Tcl_AppendPrintfToObj(errorMsg, " to \"%s\"",
+		    TclGetString(target));
 	    if (errfile != target) {
-		Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),NULL);
+		Tcl_AppendPrintfToObj(errorMsg, ": \"%s\"",
+			TclGetString(errfile));
 	    }
 	}
-	Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp), NULL);
+	Tcl_AppendPrintfToObj(errorMsg, ": %s", Tcl_PosixError(interp));
+	Tcl_SetObjResult(interp, errorMsg);
     }
     if (errorBuffer != NULL) {
 	Tcl_DecrRefCount(errorBuffer);
@@ -966,6 +967,10 @@ TclFileAttrsCmd(
     result = TCL_ERROR;
     Tcl_SetErrno(0);
 
+    /*
+     * Get the set of attribute names from the filesystem.
+     */
+
     attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
     if (attributeStrings == NULL) {
 	int index;
@@ -977,12 +982,12 @@ TclFileAttrsCmd(
 		 * There was an error, probably that the filePtr is not
 		 * accepted by any filesystem
 		 */
-		Tcl_AppendResult(interp, "could not read \"",
-			TclGetString(filePtr), "\": ", Tcl_PosixError(interp),
-			NULL);
-		return TCL_ERROR;
+
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"could not read \"%s\": %s",
+			TclGetString(filePtr), Tcl_PosixError(interp)));
 	    }
-	    goto end;
+	    return TCL_ERROR;
 	}
 
 	/*
@@ -1006,7 +1011,16 @@ TclFileAttrsCmd(
 	}
 	attributeStringsAllocated[index] = NULL;
 	attributeStrings = attributeStringsAllocated;
+    } else if (objStrings != NULL) {
+	Tcl_Panic("must not update objPtrRef's variable and return non-NULL");
     }
+
+    /*
+     * Process the attributes to produce a list of all of them, the value of a
+     * particular attribute, or to set one or more attributes (depending on
+     * the number of arguments).
+     */
+
     if (objc == 0) {
 	/*
 	 * Get all attributes.
@@ -1057,9 +1071,10 @@ TclFileAttrsCmd(
 	Tcl_Obj *objPtr = NULL;
 
 	if (numObjStrings == 0) {
-	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
-		    "\", there are no file attributes in this filesystem.",
-		    NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad option \"%s\", there are no file attributes in this"
+		    " filesystem", TclGetString(objv[0])));
+	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
 	    goto end;
 	}
 
@@ -1067,6 +1082,9 @@ TclFileAttrsCmd(
 		"option", 0, &index) != TCL_OK) {
 	    goto end;
 	}
+	if (attributeStringsAllocated != NULL) {
+	    TclFreeIntRep(objv[0]);
+	}
 	if (Tcl_FSFileAttrsGet(interp, index, filePtr,
 		&objPtr) != TCL_OK) {
 	    goto end;
@@ -1080,9 +1098,10 @@ TclFileAttrsCmd(
 	int i, index;
 
 	if (numObjStrings == 0) {
-	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
-		    "\", there are no file attributes in this filesystem.",
-		    NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "bad option \"%s\", there are no file attributes in this"
+		    " filesystem", TclGetString(objv[0])));
+	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
 	    goto end;
 	}
 
@@ -1091,9 +1110,14 @@ TclFileAttrsCmd(
 		    "option", 0, &index) != TCL_OK) {
 		goto end;
 	    }
+	    if (attributeStringsAllocated != NULL) {
+		TclFreeIntRep(objv[i]);
+	    }
 	    if (i + 1 == objc) {
-		Tcl_AppendResult(interp, "value for \"",
-			TclGetString(objv[i]), "\" missing", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"value for \"%s\" missing", TclGetString(objv[i])));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
+			"NOVALUE", NULL);
 		goto end;
 	    }
 	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
@@ -1104,21 +1128,17 @@ TclFileAttrsCmd(
     }
     result = TCL_OK;
 
+    /*
+     * Free up the array we allocated and drop our reference to any list of
+     * attribute names issued by the filesystem.
+     */
+
   end:
     if (attributeStringsAllocated != NULL) {
-	/*
-	 * Free up the array we allocated.
-	 */
-
 	TclStackFree(interp, (void *) attributeStringsAllocated);
-
-	/*
-	 * We don't need this object that was passed to us any more.
-	 */
-
-	if (objStrings != NULL) {
-	    Tcl_DecrRefCount(objStrings);
-	}
+    }
+    if (objStrings != NULL) {
+	Tcl_DecrRefCount(objStrings);
     }
     return result;
 }
@@ -1204,9 +1224,10 @@ TclFileLinkCmd(
 	     */
 
 	    if (errno == EEXIST) {
-		Tcl_AppendResult(interp, "could not create new link \"",
-			TclGetString(objv[index]),
-			"\": that path already exists", NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"could not create new link \"%s\": that path already"
+			" exists", TclGetString(objv[index])));
+		Tcl_PosixError(interp);
 	    } else if (errno == ENOENT) {
 		/*
 		 * There are two cases here: either the target doesn't exist,
@@ -1223,20 +1244,23 @@ TclFileLinkCmd(
 		access = Tcl_FSAccess(dirPtr, F_OK);
 		Tcl_DecrRefCount(dirPtr);
 		if (access != 0) {
-		    Tcl_AppendResult(interp, "could not create new link \"",
-			    TclGetString(objv[index]),
-			    "\": no such file or directory", NULL);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "could not create new link \"%s\": no such file"
+			    " or directory", TclGetString(objv[index])));
+		    Tcl_PosixError(interp);
 		} else {
-		    Tcl_AppendResult(interp, "could not create new link \"",
-			    TclGetString(objv[index]), "\": target \"",
-			    TclGetString(objv[index+1]), "\" doesn't exist",
-			    NULL);
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "could not create new link \"%s\": target \"%s\" "
+			    "doesn't exist", TclGetString(objv[index]),
+			    TclGetString(objv[index+1])));
+		    errno = ENOENT;
+		    Tcl_PosixError(interp);
 		}
 	    } else {
-		Tcl_AppendResult(interp, "could not create new link \"",
-			TclGetString(objv[index]), "\" pointing to \"",
-			TclGetString(objv[index+1]), "\": ",
-			Tcl_PosixError(interp), NULL);
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"could not create new link \"%s\" pointing to \"%s\": %s",
+			TclGetString(objv[index]),
+			TclGetString(objv[index+1]), Tcl_PosixError(interp)));
 	    }
 	    return TCL_ERROR;
 	}
@@ -1251,9 +1275,9 @@ TclFileLinkCmd(
 
 	contents = Tcl_FSLink(objv[index], NULL, 0);
 	if (contents == NULL) {
-	    Tcl_AppendResult(interp, "could not read link \"",
-		    TclGetString(objv[index]), "\": ", Tcl_PosixError(interp),
-		    NULL);
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "could not read link \"%s\": %s",
+		    TclGetString(objv[index]), Tcl_PosixError(interp)));
 	    return TCL_ERROR;
 	}
     }
@@ -1308,8 +1332,9 @@ TclFileReadLinkCmd(
     contents = Tcl_FSLink(objv[1], NULL, 0);
 
     if (contents == NULL) {
-	Tcl_AppendResult(interp, "could not readlink \"",
-		TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"could not read link \"%s\": %s",
+		TclGetString(objv[1]), Tcl_PosixError(interp)));
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, contents);
@@ -1463,8 +1488,8 @@ TclFileTemporaryCmd(
 	if (nameVarObj) {
 	    TclDecrRefCount(nameObj);
 	}
-	Tcl_AppendResult(interp, "can't create temporary file: ",
-		Tcl_PosixError(interp), NULL);
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"can't create temporary file: %s", Tcl_PosixError(interp)));
 	return TCL_ERROR;
     }
     Tcl_RegisterChannel(interp, chan);
@@ -1475,7 +1500,7 @@ TclFileTemporaryCmd(
 	    return TCL_ERROR;
 	}
     }
-    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
     return TCL_OK;
 }