summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2006-09-22 14:45:48 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2006-09-22 14:45:48 (GMT)
commit881fdb141e92e3ea0b7b72197ad32d992f78195c (patch)
treefe3cc0ced30b272142c976f51a96b394f77ab472
parent2ee60d27da9fef65d3ffb28c901bd174911d991d (diff)
downloadtcl-881fdb141e92e3ea0b7b72197ad32d992f78195c.zip
tcl-881fdb141e92e3ea0b7b72197ad32d992f78195c.tar.gz
tcl-881fdb141e92e3ea0b7b72197ad32d992f78195c.tar.bz2
Fix [Bug 1562528]
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclThreadTest.c58
2 files changed, 35 insertions, 29 deletions
diff --git a/ChangeLog b/ChangeLog
index da861af..73d45da 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2006-09-22 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclThreadTest.c (TclCreateThread): Use NULL instead of 0 as
+ end-of-strings marker to Tcl_AppendResult; the difference matters on
+ 64-bit machines. [Bug 1562528]
+
2006-09-21 Don Porter <dgp@users.sourceforge.net>
* generic/tclUtil.c: Dropped ParseInteger() routine.
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 3bb8c96..e8363da 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -1,17 +1,17 @@
/*
* tclThreadTest.c --
*
- * This file implements the testthread command. Eventually this
- * should be tclThreadCmd.c
+ * This file implements the testthread command. Eventually this should be
+ * tclThreadCmd.c
* Some of this code is based on work done by Richard Hipp on behalf of
* Conservation Through Innovation, Limited, with their permission.
*
* Copyright (c) 1998 by Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclThreadTest.c,v 1.23 2005/11/02 15:59:49 dkf Exp $
+ * RCS: @(#) $Id: tclThreadTest.c,v 1.24 2006/09/22 14:45:48 dkf Exp $
*/
#include "tclInt.h"
@@ -121,7 +121,7 @@ TCL_DECLARE_MUTEX(threadMutex)
EXTERN int TclThread_Init(Tcl_Interp *interp);
EXTERN int Tcl_ThreadObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
EXTERN int TclCreateThread(Tcl_Interp *interp, char *script,
int joinable);
EXTERN int TclThreadList(Tcl_Interp *interp);
@@ -162,7 +162,7 @@ TclThread_Init(
Tcl_Interp *interp) /* The current Tcl interpreter */
{
- Tcl_CreateObjCommand(interp,"testthread", Tcl_ThreadObjCmd,
+ Tcl_CreateObjCommand(interp, "testthread", Tcl_ThreadObjCmd,
(ClientData) NULL, NULL);
return TCL_OK;
}
@@ -173,8 +173,8 @@ TclThread_Init(
*
* Tcl_ThreadObjCmd --
*
- * This procedure is invoked to process the "testthread" Tcl command.
- * See the user documentation for details on what it does.
+ * This procedure is invoked to process the "testthread" Tcl command. See
+ * the user documentation for details on what it does.
*
* thread create ?-joinable? ?script?
* thread send id ?-async? script
@@ -200,25 +200,25 @@ Tcl_ThreadObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument objects. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int option;
- static CONST char *threadOptions[] = {
+ static const char *threadOptions[] = {
"create", "exit", "id", "join", "names",
"send", "wait", "errorproc", NULL
};
enum options {
- THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN,
- THREAD_NAMES, THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC
+ THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES,
+ THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions,
- "option", 0, &option) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
+ &option) != TCL_OK) {
return TCL_ERROR;
}
@@ -246,7 +246,6 @@ Tcl_ThreadObjCmd(
joinable = 0;
script = "testthread wait"; /* Just enter event loop */
-
} else if (objc == 3) {
/*
* Possibly -joinable, then no special script, no joinable, then
@@ -287,7 +286,7 @@ Tcl_ThreadObjCmd(
}
case THREAD_EXIT:
if (objc > 2) {
- Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
ListRemove(NULL);
@@ -308,7 +307,7 @@ Tcl_ThreadObjCmd(
int result, status;
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "join id");
+ Tcl_WrongNumArgs(interp, 2, objv, "id");
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
@@ -338,12 +337,12 @@ Tcl_ThreadObjCmd(
int wait, arg;
if ((objc != 4) && (objc != 5)) {
- Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script");
+ Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
return TCL_ERROR;
}
if (objc == 5) {
if (strcmp("-async", Tcl_GetString(objv[2])) != 0) {
- Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script");
+ Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
return TCL_ERROR;
}
wait = 0;
@@ -367,7 +366,7 @@ Tcl_ThreadObjCmd(
char *proc;
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "errorproc proc");
+ Tcl_WrongNumArgs(interp, 2, objv, "proc");
return TCL_ERROR;
}
Tcl_MutexLock(&threadMutex);
@@ -424,10 +423,10 @@ TclCreateThread(
Tcl_MutexLock(&threadMutex);
if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl,
- TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
+ TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
- Tcl_AppendResult(interp,"can't create a new thread",0);
- ckfree((void*)ctrl.script);
+ Tcl_AppendResult(interp, "can't create a new thread", NULL);
+ ckfree((char *) ctrl.script);
return TCL_ERROR;
}
@@ -506,7 +505,7 @@ NewTestThread(
* eval'ing, for the case that we exit during evaluation
*/
- threadEvalScript = (char *) ckalloc(strlen(ctrlPtr->script)+1);
+ threadEvalScript = ckalloc(strlen(ctrlPtr->script)+1);
strcpy(threadEvalScript, ctrlPtr->script);
Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
@@ -561,7 +560,7 @@ ThreadErrorProc(
Tcl_Interp *interp) /* Interp that failed */
{
Tcl_Channel errChannel;
- CONST char *errorInfo, *argv[3];
+ const char *errorInfo, *argv[3];
char *script;
char buf[TCL_DOUBLE_SPACE+1];
sprintf(buf, "%ld", (long) Tcl_GetCurrentThread());
@@ -681,7 +680,7 @@ TclThreadList(
Tcl_MutexLock(&threadMutex);
for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewLongObj((long)tsdPtr->threadId));
+ Tcl_NewLongObj((long) tsdPtr->threadId));
}
Tcl_MutexUnlock(&threadMutex);
Tcl_SetObjResult(interp, listPtr);
@@ -869,7 +868,7 @@ ThreadEventProc(
ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
Tcl_Interp *interp = tsdPtr->interp;
int code;
- CONST char *result, *errorCode, *errorInfo;
+ const char *result, *errorCode, *errorInfo;
if (interp == NULL) {
code = TCL_ERROR;
@@ -1030,7 +1029,7 @@ ThreadExitProc(
}
resultPtr->nextPtr = resultPtr->prevPtr = 0;
resultPtr->eventPtr->resultPtr = NULL;
- ckfree((char *)resultPtr);
+ ckfree((char *) resultPtr);
} else if (resultPtr->dstThreadId == self) {
/*
* Dang. The target is going away. Unblock the caller. The result
@@ -1039,6 +1038,7 @@ ThreadExitProc(
*/
char *msg = "target thread died";
+
resultPtr->result = ckalloc(strlen(msg)+1);
strcpy(resultPtr->result, msg);
resultPtr->code = TCL_ERROR;