diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | library/dde/pkgIndex.tcl | 4 | ||||
| -rw-r--r-- | win/tclWinDde.c | 70 | ||||
| -rw-r--r-- | win/tclWinFCmd.c | 22 | ||||
| -rw-r--r-- | win/tclWinPipe.c | 8 |
5 files changed, 55 insertions, 53 deletions
@@ -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; } |