* generic/tclBasic.c:

        * generic/tclBinary.c:
        * generic/tclCmdAH.c:
        * generic/tclCmdIL.c:
        It is a poor practice to directly set or append to the value
        of the objResult of an interp, because that value might be
        shared, and in that circumstance a Tcl_Panic() will be the
        result.  Searched for example of this practice and replaced
        with safer alternatives, often using the Tcl_AppendResult()
        routine that dkf just rehabilitated.

1 files changed, 52 insertions, 64 deletions

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 676fa3d..c2134e0 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.62 2004/04/06 22:25:49 dgp Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.63 2004/10/06 03:43:40 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -543,8 +543,8 @@ InfoArgsCmd(dummy, interp, objc, objv)
     name = Tcl_GetString(objv[2]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"\"", name, "\" isn't a procedure", (char *) NULL);
+	Tcl_AppendResult(interp, "\"", name,
+		"\" isn't a procedure", (char *) NULL);
 	return TCL_ERROR;
     }
 
@@ -604,8 +604,8 @@ InfoBodyCmd(dummy, interp, objc, objv)
     name = Tcl_GetString(objv[2]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"\"", name, "\" isn't a procedure", (char *) NULL);
+	Tcl_AppendResult(interp, "\"", name,
+		"\" isn't a procedure", (char *) NULL);
 	return TCL_ERROR;
     }
 
@@ -667,7 +667,7 @@ InfoCmdCountCmd(dummy, interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->cmdCount);
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->cmdCount));
     return TCL_OK;
 }
 
@@ -834,9 +834,9 @@ InfoCompleteCmd(dummy, interp, objc, objv)
     }
 
     if (TclObjCommandComplete(objv[2])) {
-	Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
     } else {
-	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
     }
 
     return TCL_OK;
@@ -886,8 +886,8 @@ InfoDefaultCmd(dummy, interp, objc, objv)
 
     procPtr = TclFindProc(iPtr, procName);
     if (procPtr == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"\"", procName, "\" isn't a procedure", (char *) NULL);
+	Tcl_AppendResult(interp, "\"", procName,
+		"\" isn't a procedure", (char *) NULL);
 	return TCL_ERROR;
     }
 
@@ -901,12 +901,12 @@ InfoDefaultCmd(dummy, interp, objc, objv)
 		if (valueObjPtr == NULL) {
 		    defStoreError:
 		    varName = Tcl_GetString(objv[4]);
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    Tcl_AppendResult(interp,
 			    "couldn't store default value in variable \"",
 			    varName, "\"", (char *) NULL);
 		    return TCL_ERROR;
 		}
-		Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
 	    } else {
 		Tcl_Obj *nullObjPtr = Tcl_NewObj();
 		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
@@ -915,15 +915,14 @@ InfoDefaultCmd(dummy, interp, objc, objv)
 		    Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
 		    goto defStoreError;
 		}
-		Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
 	    }
 	    return TCL_OK;
 	}
     }
 
-    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-	    "procedure \"", procName, "\" doesn't have an argument \"",
-	    argName, "\"", (char *) NULL);
+    Tcl_AppendResult(interp, "procedure \"", procName,
+	    "\" doesn't have an argument \"", argName, "\"", (char *) NULL);
     return TCL_ERROR;
 }
 
@@ -965,9 +964,9 @@ InfoExistsCmd(dummy, interp, objc, objv)
     varName = Tcl_GetString(objv[2]);
     varPtr = TclVarTraceExists(interp, varName);
     if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
-	Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
     } else {
-	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
     }
     return TCL_OK;
 }
@@ -1122,11 +1121,11 @@ InfoHostnameCmd(dummy, interp, objc, objv)
 
     name = Tcl_GetHostName();
     if (name) {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
 	return TCL_OK;
     } else {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp),
-		"unable to determine name of host", -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"unable to determine name of host", -1));
 	return TCL_ERROR;
     }
 }
@@ -1165,9 +1164,9 @@ InfoLevelCmd(dummy, interp, objc, objv)
 
     if (objc == 2) {		/* just "info level" */
 	if (iPtr->varFramePtr == NULL) {
-	    Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
 	} else {
-	    Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->varFramePtr->level);
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
 	}
 	return TCL_OK;
     } else if (objc == 3) {
@@ -1177,10 +1176,8 @@ InfoLevelCmd(dummy, interp, objc, objv)
 	if (level <= 0) {
 	    if (iPtr->varFramePtr == NULL) {
 		levelError:
-		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			"bad level \"",
-			Tcl_GetString(objv[2]),
-			"\"", (char *) NULL);
+		Tcl_AppendResult(interp, "bad level \"",
+			Tcl_GetString(objv[2]), "\"", (char *) NULL);
 		return TCL_ERROR;
 	    }
 	    level += iPtr->varFramePtr->level;
@@ -1241,11 +1238,11 @@ InfoLibraryCmd(dummy, interp, objc, objv)
 
     libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
     if (libDirName != NULL) {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp), libDirName, -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
 	return TCL_OK;
     }
-    Tcl_SetStringObj(Tcl_GetObjResult(interp), 
-	    "no library has been specified for Tcl", -1);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    "no library has been specified for Tcl", -1));
     return TCL_ERROR;
 }
 
@@ -1462,7 +1459,7 @@ InfoNameOfExecutableCmd(dummy, interp, objc, objv)
     nameOfExecutable = Tcl_GetNameOfExecutable();
 
     if (nameOfExecutable != NULL) {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp), nameOfExecutable, -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(nameOfExecutable, -1));
     }
     return TCL_OK;
 }
@@ -1505,7 +1502,7 @@ InfoPatchLevelCmd(dummy, interp, objc, objv)
     patchlevel = Tcl_GetVar(interp, "tcl_patchLevel",
 	    (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
     if (patchlevel != NULL) {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp), patchlevel, -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1));
 	return TCL_OK;
     }
     return TCL_ERROR;
@@ -1751,7 +1748,7 @@ InfoSharedlibCmd(dummy, interp, objc, objv)
     }
 
 #ifdef TCL_SHLIB_EXT
-    Tcl_SetStringObj(Tcl_GetObjResult(interp), TCL_SHLIB_EXT, -1);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, -1));
 #endif
     return TCL_OK;
 }
@@ -1783,17 +1780,17 @@ InfoTclVersionCmd(dummy, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    CONST char *version;
+    Tcl_Obj *version;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 2, objv, NULL);
 	return TCL_ERROR;
     }
 
-    version = Tcl_GetVar(interp, "tcl_version",
+    version = Tcl_GetVar2Ex(interp, "tcl_version", NULL,
 	(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
     if (version != NULL) {
-	Tcl_SetStringObj(Tcl_GetObjResult(interp), version, -1);
+	Tcl_SetObjResult(interp, version);
 	return TCL_OK;
     }
     return TCL_ERROR;
@@ -2004,12 +2001,10 @@ Tcl_JoinObjCmd(dummy, interp, objc, objv)
     }
 
     /*
-     * Now concatenate strings to form the "joined" result. We append
-     * directly into the interpreter's result object.
+     * Now concatenate strings to form the "joined" result.
      */
 
-    resObjPtr = Tcl_GetObjResult(interp);
-
+    resObjPtr = Tcl_NewObj();
     for (i = 0;  i < listLen;  i++) {
 	bytes = Tcl_GetStringFromObj(elemPtrs[i], &length);
 	if (i > 0) {
@@ -2017,6 +2012,7 @@ Tcl_JoinObjCmd(dummy, interp, objc, objv)
 	}
 	Tcl_AppendToObj(resObjPtr, bytes, length);
     }
+    Tcl_SetObjResult(interp, resObjPtr);
     return TCL_OK;
 }
 
@@ -2580,11 +2576,11 @@ Tcl_ListObjCmd(dummy, interp, objc, objv)
 {
     /*
      * If there are no list elements, the result is an empty object.
-     * Otherwise modify the interpreter's result object to be a list object.
+     * Otherwise set the interpreter's result object to be a list object.
      */
 
     if (objc > 1) {
-	Tcl_SetListObj(Tcl_GetObjResult(interp), (objc-1), &(objv[1]));
+	Tcl_SetObjResult(interp, Tcl_NewListObj((objc-1), &(objv[1])));
     }
     return TCL_OK;
 }
@@ -2631,7 +2627,7 @@ Tcl_LlengthObjCmd(dummy, interp, objc, objv)
      * length. 
      */
 
-    Tcl_SetIntObj(Tcl_GetObjResult(interp), listLen);
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(listLen));
     return TCL_OK;
 }
 
@@ -2725,7 +2721,7 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
      */
 
     numElems = (last - first + 1);
-    Tcl_SetListObj(Tcl_GetObjResult(interp), numElems, &(elemPtrs[first]));
+    Tcl_SetObjResult(interp, Tcl_NewListObj(numElems, &(elemPtrs[first])));
     return TCL_OK;
 }
 
@@ -2912,8 +2908,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
      */
 
     if ((first >= listLen) && (listLen > 0)) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"list doesn't contain element ",
+	Tcl_AppendResult(interp, "list doesn't contain element ",
 		Tcl_GetString(objv[2]), (int *) NULL);
 	return TCL_ERROR;
     }
@@ -3521,7 +3516,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	    }
 	    Tcl_SetObjResult(interp, itemPtr);
 	} else {
-	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
 	}
     } else if (index < 0) {
 	/*
@@ -3664,7 +3659,6 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 	LSORT_UNIQUE
     };
 
-    resultPtr = Tcl_GetObjResult(interp);
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?options? list");
 	return TCL_ERROR;
@@ -3696,9 +3690,9 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 		if (sortInfo.indexc > 1) {
 		    ckfree((char *) sortInfo.indexv);
 		}
-		Tcl_AppendToObj(resultPtr,
-			"\"-command\" option must be followed by comparison command",
-			-1);
+		Tcl_AppendResult(interp,
+			"\"-command\" option must be followed ",
+			"by comparison command", NULL);
 		return TCL_ERROR;
 	    }
 	    sortInfo.sortMode = SORTMODE_COMMAND;
@@ -3722,9 +3716,8 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 		ckfree((char *) sortInfo.indexv);
 	    }
 	    if (i == (objc-2)) {
-		Tcl_AppendToObj(resultPtr,
-			"\"-index\" option must be followed by list index",
-			-1);
+		Tcl_AppendResult(interp, "\"-index\" option must be ",
+			"followed by list index", NULL);
 		return TCL_ERROR;
 	    }
 	    /*
@@ -3822,13 +3815,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
     elementArray[length-1].nextPtr = NULL;
     elementPtr = MergeSort(elementArray, &sortInfo);
     if (sortInfo.resultCode == TCL_OK) {
-	/*
-	 * Note: must clear the interpreter's result object: it could
-	 * have been set by the -command script.
-	 */
-
-	Tcl_ResetResult(interp);
-	resultPtr = Tcl_GetObjResult(interp);
+	resultPtr = Tcl_NewObj();
 	if (unique) {
 	    for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
 		if (elementPtr->count == 0) {
@@ -3842,6 +3829,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 			elementPtr->objPtr);
 	    }
 	}
+	Tcl_SetObjResult(interp, resultPtr);
     }
     ckfree((char*) elementArray);
 
@@ -4099,8 +4087,8 @@ SortCompare(objPtr1, objPtr2, infoPtr)
 	if (Tcl_GetIntFromObj(infoPtr->interp,
 		Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
 	    Tcl_ResetResult(infoPtr->interp);
-	    Tcl_AppendToObj(Tcl_GetObjResult(infoPtr->interp),
-		    "-compare command returned non-integer result", -1);
+	    Tcl_AppendResult(infoPtr->interp,
+		    "-compare command returned non-integer result", NULL);
 	    infoPtr->resultCode = TCL_ERROR;
 	    return order;
 	}
@@ -4312,7 +4300,7 @@ SelectObjFromSublist(objPtr, infoPtr)
 	if (currentObj == NULL) {
 	    char buffer[TCL_INTEGER_SPACE];
 	    TclFormatInt(buffer, index);
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
+	    Tcl_AppendResult(infoPtr->interp,
 		    "element ", buffer, " missing from sublist \"",
 		    Tcl_GetString(objPtr), "\"", (char *) NULL);
 	    infoPtr->resultCode = TCL_ERROR;