From 757296c3e92ae4145012c8081d89063fd84fac6d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 6 Oct 2004 16:37:17 +0000
Subject: * 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
---
ChangeLog | 4 +++
library/dde/pkgIndex.tcl | 4 +--
win/tclWinDde.c | 70 +++++++++++++++++++++++++-----------------------
win/tclWinFCmd.c | 22 +++++++--------
win/tclWinPipe.c | 8 +++---
5 files changed, 55 insertions(+), 53 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 1b25644..9c16ba9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -36,12 +36,16 @@
* 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
2004-10-06 Donal K. Fellows <donal.k.fellows@man.ac.uk>
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index d8d2d6e..d069046 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,7 +1,7 @@
if {![package vsatisfies [package provide Tcl] 8]} {return}
if {[string compare $::tcl_platform(platform) windows]} {return}
if {[info exists ::tcl_platform(debug)]} {
- package ifneeded dde 1.3 [list load [file join $dir tcldde13g.dll] dde]
+ package ifneeded dde 1.3.1 [list load [file join $dir tcldde13g.dll] dde]
} else {
- package ifneeded dde 1.3 [list load [file join $dir tcldde13.dll] dde]
+ package ifneeded dde 1.3.1 [list load [file join $dir tcldde13.dll] dde]
}
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;
}
--
cgit v0.12