* generic/tclBasic.c:

        * generic/tclBinary.c:
        * generic/tclCmdAH.c:
        * generic/tclCmdIL.c:
        * generic/tclCmdMZ.c:
        * generic/tclCompExpr.c:
        * generic/tclDictObj.c:
        * generic/tclEncoding.c:
        * generic/tclExecute.c:
        * generic/tclFCmd.c:
        * generic/tclHistory.c:
        * generic/tclIndexObj.c:
        * generic/tclInterp.c:
        * generic/tclIO.c:
        * generic/tclIOCmd.c:
        * generic/tclNamesp.c:
        * generic/tclObj.c:
        * generic/tclPkg.c:
        * generic/tclResult.c:
        * generic/tclScan.c:
        * generic/tclTimer.c:
        * generic/tclTrace.c:
        * generic/tclUtil.c:
        * generic/tclVar.c:
        * unix/tclUnixFCmd.c:
        * unix/tclUnixPipe.c:
        * win/tclWinDde.c:
        * win/tclWinFCmd.c:
        * win/tclWinPipe.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.
        * library/dde/pkgIndex.tcl: Bump to dde 1.3.1

3 files changed, 49 insertions, 51 deletions

diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 16e32ff..b1599f7 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinDde.c,v 1.22 2004/10/06 14:10:27 dkf Exp $
+ * RCS: @(#) $Id: tclWinDde.c,v 1.23 2004/10/06 16:37:18 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -71,7 +71,7 @@ static DWORD ddeInstance;       /* The application instance handle given
 				 * to us by DdeInitialize. */
 static int ddeIsServer = 0;
 
-#define TCL_DDE_VERSION "1.3"
+#define TCL_DDE_VERSION "1.3.1"
 #define TCL_DDE_PACKAGE_NAME "dde"
 #define TCL_DDE_SERVICE_NAME "TclEval"
 
@@ -1007,23 +1007,29 @@ DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam)
     if ((es->service == (ATOM)NULL || es->service == service)
 	&& (es->topic == (ATOM)NULL || es->topic == topic)) {
 	Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
+	Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
 
 	GlobalGetAtomName((ATOM)service, sz, 255);
-	Tcl_ListObjAppendElement(es->interp, matchPtr,
+	Tcl_ListObjAppendElement(NULL, matchPtr,
 		Tcl_NewStringObj(sz, -1));
 	GlobalGetAtomName(topic, sz, 255);
-	Tcl_ListObjAppendElement(es->interp, matchPtr,
+	Tcl_ListObjAppendElement(NULL, matchPtr,
 		Tcl_NewStringObj(sz, -1));
 	/* Adding the hwnd as a third list element provides a unique
 	 * identifier in the case of multiple servers with the name
 	 * application and topic names.
 	 */
 	/* Needs a TIP though
-	 * Tcl_ListObjAppendElement(es->interp, matchPtr,
+	 * Tcl_ListObjAppendElement(NULL, matchPtr,
 	 *	Tcl_NewLongObj((long)hwndRemote));
 	 */
-	Tcl_ListObjAppendElement(es->interp,
-		Tcl_GetObjResult(es->interp), matchPtr);
+	if (Tcl_IsShared(resultPtr)) {
+	    resultPtr = Tcl_DuplicateObj(resultPtr);
+	}
+	if (Tcl_ListObjAppendElement(es->interp, resultPtr, matchPtr)
+		== TCL_OK) {
+	    Tcl_SetObjResult(es->interp, resultPtr);
+	}
     }
 
     /* tell the server we are no longer interested */
@@ -1093,29 +1099,27 @@ static void
 SetDdeError(
     Tcl_Interp *interp)	    /* The interp to put the message in.*/
 {
-    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
-    int err;
-
-    err = DdeGetLastError(ddeInstance);
-    switch (err) {
+    switch (DdeGetLastError(ddeInstance)) {
 	case DMLERR_DATAACKTIMEOUT:
 	case DMLERR_EXECACKTIMEOUT:
 	case DMLERR_POKEACKTIMEOUT:
-	    Tcl_SetStringObj(resultPtr,
-		    "remote interpreter did not respond", -1);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "remote interpreter did not respond", -1));
 	    break;
 
 	case DMLERR_BUSY:
-	    Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "remote server is busy", -1));
 	    break;
 
 	case DMLERR_NOTPROCESSED:
-	    Tcl_SetStringObj(resultPtr, 
-		    "remote server cannot handle this command", -1);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "remote server cannot handle this command", -1));
 	    break;
 
 	default:
-	    Tcl_SetStringObj(resultPtr, "dde command failed", -1);
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("dde command failed", -1));
     }
 }
 
@@ -1223,10 +1227,9 @@ Tcl_DdeObjCmd(
 		    break;
 		} else {
 		    Tcl_ResetResult(interp);
-		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-			    "bad option \"", Tcl_GetString(objv[i]),
-			    "\": must be -force, -handler or --",
-			    (char*)NULL);
+		    Tcl_AppendResult(interp, "bad option \"",
+			    Tcl_GetString(objv[i]),
+			    "\": must be -force, -handler or --", (char*)NULL);
 		    return TCL_ERROR;
 		}
 	    }
@@ -1364,8 +1367,7 @@ Tcl_DdeObjCmd(
 	    serviceName = DdeSetServerName(interp, serviceName,
 		   exact, handlerPtr);
 	    if (serviceName != NULL) {
-		Tcl_SetStringObj(Tcl_GetObjResult(interp),
-			serviceName, -1);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
 	    } else {
 		Tcl_ResetResult(interp);
 	    }
@@ -1374,8 +1376,8 @@ Tcl_DdeObjCmd(
 	case DDE_EXECUTE: {
 	    dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
 	    if (dataLength == 0) {
-		Tcl_SetStringObj(Tcl_GetObjResult(interp),
-			"cannot execute null data", -1);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"cannot execute null data", -1));
 		result = TCL_ERROR;
 		break;
 	    }
@@ -1415,8 +1417,8 @@ Tcl_DdeObjCmd(
 	case DDE_REQUEST: {
 	    itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
 	    if (length == 0) {
-		Tcl_SetStringObj(Tcl_GetObjResult(interp),
-			"cannot request value of null data", -1);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"cannot request value of null data", -1));
 		goto errorNoResult;
 	    }
 	    hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
@@ -1461,8 +1463,8 @@ Tcl_DdeObjCmd(
 	case DDE_POKE: {
 	    itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
 	    if (length == 0) {
-		Tcl_SetStringObj(Tcl_GetObjResult(interp),
-			"cannot have a null item", -1);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"cannot have a null item", -1));
 		goto errorNoResult;
 	    }
 	    dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);
@@ -1498,8 +1500,8 @@ Tcl_DdeObjCmd(
 	}
 	case DDE_EVAL: {
 	    if (serviceName == NULL) {
-		Tcl_SetStringObj(Tcl_GetObjResult(interp),
-			"invalid service name \"\"", -1);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			"invalid service name \"\"", -1));
 		goto errorNoResult;
 	    }
 
@@ -1706,8 +1708,8 @@ Tcl_DdeObjCmd(
     return result;
 
     error:
-    Tcl_SetStringObj(Tcl_GetObjResult(interp),
-	    "invalid data returned from server", -1);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	    "invalid data returned from server", -1));
 
     errorNoResult:
     if (ddeCookie != NULL) {
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index ac7045d..1821f8f 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinFCmd.c,v 1.42 2004/10/06 14:14:30 dkf Exp $
+ * RCS: @(#) $Id: tclWinFCmd.c,v 1.43 2004/10/06 16:37:18 dgp Exp $
  */
 
 #include "tclWinInt.h"
@@ -1548,10 +1548,8 @@ StatError(
 				 * error. */
 {
     TclWinConvertError(GetLastError());
-    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
-			   "could not read \"", Tcl_GetString(fileName), 
-			   "\": ", Tcl_PosixError(interp), 
-			   (char *) NULL);
+    Tcl_AppendResult(interp, "could not read \"", Tcl_GetString(fileName), 
+	    "\": ", Tcl_PosixError(interp), (char *) NULL);
 }
 
 /*
@@ -1662,10 +1660,9 @@ ConvertFileNameFormat(
     
     if (splitPath == NULL || pathc == 0) {
 	if (interp != NULL) {
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
-		"could not read \"", Tcl_GetString(fileName),
-		"\": no such file or directory", 
-		(char *) NULL);
+	    Tcl_AppendResult(interp, "could not read \"",
+		    Tcl_GetString(fileName), "\": no such file or directory", 
+		    (char *) NULL);
 	}
 	goto cleanup;
     }
@@ -1957,10 +1954,9 @@ CannotSetAttribute(
     Tcl_Obj *fileName,	        /* The name of the file. */
     Tcl_Obj *attributePtr)	/* The new value of the attribute. */
 {
-    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
-	    "cannot set attribute \"", tclpFileAttrStrings[objIndex],
-	    "\" for file \"", Tcl_GetString(fileName), 
-	    "\": attribute is readonly", 
+    Tcl_AppendResult(interp, "cannot set attribute \"",
+	    tclpFileAttrStrings[objIndex], "\" for file \"",
+	    Tcl_GetString(fileName), "\": attribute is readonly",
 	    (char *) NULL);
     return TCL_ERROR;
 }
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 13e26cd..b055afc 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinPipe.c,v 1.49 2004/10/06 14:35:20 dkf Exp $
+ * RCS: @(#) $Id: tclWinPipe.c,v 1.50 2004/10/06 16:37:18 dgp Exp $
  */
 
 #include "tclWinInt.h"
@@ -2699,9 +2699,8 @@ Tcl_PidObjCmd(
 	return TCL_ERROR;
     }
     if (objc == 1) {
-	resultPtr = Tcl_GetObjResult(interp);
 	wsprintfA(buf, "%lu", (unsigned long) getpid());
-	Tcl_SetStringObj(resultPtr, buf, -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
     } else {
         chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
 		NULL);
@@ -2714,12 +2713,13 @@ Tcl_PidObjCmd(
 	}
 
         pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
-	resultPtr = Tcl_GetObjResult(interp);
+	resultPtr = Tcl_NewObj();
         for (i = 0; i < pipePtr->numPids; i++) {
 	    wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
 	    Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
 		    Tcl_NewStringObj(buf, -1));
 	}
+	Tcl_SetObjResult(interp, resultPtr);
     }
     return TCL_OK;
 }