diff options
Diffstat (limited to 'generic/tclEvent.c')
-rw-r--r-- | generic/tclEvent.c | 336 |
1 files changed, 202 insertions, 134 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 7daa7bb..78bd7b8 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -49,8 +49,8 @@ typedef struct ErrAssocData { } ErrAssocData; /* - * For each exit handler created with a call to Tcl_Create(Late)ExitHandler there is - * a structure of the following type: + * For each exit handler created with a call to Tcl_Create(Late)ExitHandler + * there is a structure of the following type: */ typedef struct ExitHandler { @@ -74,19 +74,19 @@ static ExitHandler *firstLateExitPtr = NULL; TCL_DECLARE_MUTEX(exitMutex) /* - * This variable is set to 1 when Tcl_Finalize is called, and at the end of - * its work, it is reset to 0. The variable is checked by TclInExit() to allow - * different behavior for exit-time processing, e.g. in closing of files and - * pipes. + * This variable is set to 1 when Tcl_Exit is called. The variable is checked + * by TclInExit() to allow different behavior for exit-time processing, e.g., + * in closing of files and pipes. */ -static int inFinalize = 0; +static int inExit = 0; + static int subsystemsInitialized = 0; /* - * This variable contains the application wide exit handler. It will be - * called by Tcl_Exit instead of the C-runtime exit if this variable is set - * to a non-NULL value. + * This variable contains the application wide exit handler. It will be called + * by Tcl_Exit instead of the C-runtime exit if this variable is set to a + * non-NULL value. */ static Tcl_ExitProc *appExitPtr = NULL; @@ -115,8 +115,10 @@ static Tcl_ThreadCreateType NewThreadProc(ClientData clientData); static void BgErrorDeleteProc(ClientData clientData, Tcl_Interp *interp); static void HandleBgErrors(ClientData clientData); -static char * VwaitVarProc(ClientData clientData, Tcl_Interp *interp, - CONST char *name1, CONST char *name2, int flags); +static char * VwaitVarProc(ClientData clientData, + Tcl_Interp *interp, const char *name1, + const char *name2, int flags); +static void InvokeExitHandlers(void); /* *---------------------------------------------------------------------- @@ -141,10 +143,11 @@ Tcl_BackgroundError( Tcl_Interp *interp) /* Interpreter in which an error has * occurred. */ { - TclBackgroundException(interp, TCL_ERROR); + Tcl_BackgroundException(interp, TCL_ERROR); } + void -TclBackgroundException( +Tcl_BackgroundException( Tcl_Interp *interp, /* Interpreter in which an exception has * occurred. */ int code) /* The exception code value */ @@ -156,7 +159,7 @@ TclBackgroundException( return; } - errPtr = (BgError *) ckalloc(sizeof(BgError)); + errPtr = ckalloc(sizeof(BgError)); errPtr->errorMsg = Tcl_GetObjResult(interp); Tcl_IncrRefCount(errPtr->errorMsg); errPtr->returnOpts = Tcl_GetReturnOptions(interp, code); @@ -164,10 +167,10 @@ TclBackgroundException( errPtr->nextPtr = NULL; (void) TclGetBgErrorHandler(interp); - assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError", NULL); + assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL); if (assocPtr->firstBgPtr == NULL) { assocPtr->firstBgPtr = errPtr; - Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr); + Tcl_DoWhenIdle(HandleBgErrors, assocPtr); } else { assocPtr->lastBgPtr->nextPtr = errPtr; } @@ -196,7 +199,7 @@ static void HandleBgErrors( ClientData clientData) /* Pointer to ErrAssocData structure. */ { - ErrAssocData *assocPtr = (ErrAssocData *) clientData; + ErrAssocData *assocPtr = clientData; Tcl_Interp *interp = assocPtr->interp; BgError *errPtr; @@ -207,15 +210,15 @@ HandleBgErrors( * that could lead us here. */ - Tcl_Preserve((ClientData) assocPtr); - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(assocPtr); + Tcl_Preserve(interp); while (assocPtr->firstBgPtr != NULL) { int code, prefixObjc; Tcl_Obj **prefixObjv, **tempObjv; /* - * Note we copy the handler command prefix each pass through, so - * we do support one handler setting another handler. + * Note we copy the handler command prefix each pass through, so we do + * support one handler setting another handler. */ Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix); @@ -223,7 +226,7 @@ HandleBgErrors( errPtr = assocPtr->firstBgPtr; Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); - tempObjv = (Tcl_Obj **) ckalloc((prefixObjc+2)*sizeof(Tcl_Obj *)); + tempObjv = ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; tempObjv[prefixObjc+1] = errPtr->returnOpts; @@ -238,8 +241,8 @@ HandleBgErrors( Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); assocPtr->firstBgPtr = errPtr->nextPtr; - ckfree((char *) errPtr); - ckfree((char *) tempObjv); + ckfree(errPtr); + ckfree(tempObjv); if (code == TCL_BREAK) { /* @@ -252,12 +255,12 @@ HandleBgErrors( assocPtr->firstBgPtr = errPtr->nextPtr; Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); - ckfree((char *) errPtr); + ckfree(errPtr); } } else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) { Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); - if (errChannel != (Tcl_Channel) NULL) { + if (errChannel != NULL) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); Tcl_Obj *keyPtr, *valuePtr; @@ -280,8 +283,8 @@ HandleBgErrors( } } assocPtr->lastBgPtr = NULL; - Tcl_Release((ClientData) interp); - Tcl_Release((ClientData) assocPtr); + Tcl_Release(interp); + Tcl_Release(assocPtr); } /* @@ -307,7 +310,7 @@ TclDefaultBgErrorHandlerObjCmd( 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. */ { Tcl_Obj *keyPtr, *valuePtr; Tcl_Obj *tempObjv[2]; @@ -349,19 +352,26 @@ TclDefaultBgErrorHandlerObjCmd( } if (level != 0) { - /* We're handling a TCL_RETURN exception */ + /* + * We're handling a TCL_RETURN exception. + */ + code = TCL_RETURN; } if (code == TCL_OK) { /* - * Somehow we got to exception handling with no exception. - * (Pass TCL_OK to TclBackgroundException()?) - * Just return without doing anything. + * Somehow we got to exception handling with no exception. (Pass + * TCL_OK to Tcl_BackgroundException()?) Just return without doing + * anything. */ + return TCL_OK; } - /* Construct the bgerror command */ + /* + * Construct the bgerror command. + */ + TclNewLiteralStringObj(tempObjv[0], "bgerror"); Tcl_IncrRefCount(tempObjv[0]); @@ -418,8 +428,11 @@ TclDefaultBgErrorHandlerObjCmd( */ saved = Tcl_SaveInterpState(interp, code); - - /* Invoke the bgerror command. */ + + /* + * Invoke the bgerror command. + */ + Tcl_AllowExceptions(interp); code = Tcl_EvalObjv(interp, 2, tempObjv, TCL_EVAL_GLOBAL); if (code == TCL_ERROR) { @@ -438,7 +451,8 @@ TclDefaultBgErrorHandlerObjCmd( TclObjInvoke(interp, 2, tempObjv, TCL_INVOKE_HIDDEN); } else { Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); - if (errChannel != (Tcl_Channel) NULL) { + + if (errChannel != NULL) { Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); @@ -498,8 +512,7 @@ TclSetBgErrorHandler( Tcl_Interp *interp, Tcl_Obj *cmdPrefix) { - ErrAssocData *assocPtr = (ErrAssocData *) - Tcl_GetAssocData(interp, "tclBgError", NULL); + ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL); if (cmdPrefix == NULL) { Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument"); @@ -509,13 +522,12 @@ TclSetBgErrorHandler( * First access: initialize. */ - assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData)); + assocPtr = ckalloc(sizeof(ErrAssocData)); assocPtr->interp = interp; assocPtr->cmdPrefix = NULL; assocPtr->firstBgPtr = NULL; assocPtr->lastBgPtr = NULL; - Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, - (ClientData) assocPtr); + Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr); } if (assocPtr->cmdPrefix) { Tcl_DecrRefCount(assocPtr->cmdPrefix); @@ -545,16 +557,14 @@ Tcl_Obj * TclGetBgErrorHandler( Tcl_Interp *interp) { - ErrAssocData *assocPtr = (ErrAssocData *) - Tcl_GetAssocData(interp, "tclBgError", NULL); + ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL); if (assocPtr == NULL) { Tcl_Obj *bgerrorObj; TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror"); TclSetBgErrorHandler(interp, bgerrorObj); - assocPtr = (ErrAssocData *) - Tcl_GetAssocData(interp, "tclBgError", NULL); + assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL); } return assocPtr->cmdPrefix; } @@ -573,7 +583,7 @@ TclGetBgErrorHandler( * * Side effects: * Background error information is freed: if there were any pending error - * reports, they are cancelled. + * reports, they are canceled. * *---------------------------------------------------------------------- */ @@ -583,7 +593,7 @@ BgErrorDeleteProc( ClientData clientData, /* Pointer to ErrAssocData structure. */ Tcl_Interp *interp) /* Interpreter being deleted. */ { - ErrAssocData *assocPtr = (ErrAssocData *) clientData; + ErrAssocData *assocPtr = clientData; BgError *errPtr; while (assocPtr->firstBgPtr != NULL) { @@ -591,11 +601,11 @@ BgErrorDeleteProc( assocPtr->firstBgPtr = errPtr->nextPtr; Tcl_DecrRefCount(errPtr->errorMsg); Tcl_DecrRefCount(errPtr->returnOpts); - ckfree((char *) errPtr); + ckfree(errPtr); } - Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr); + Tcl_CancelIdleCall(HandleBgErrors, assocPtr); Tcl_DecrRefCount(assocPtr->cmdPrefix); - Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC); + Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC); } /* @@ -621,9 +631,8 @@ Tcl_CreateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - ExitHandler *exitPtr; + ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler)); - exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; Tcl_MutexLock(&exitMutex); @@ -637,7 +646,8 @@ Tcl_CreateExitHandler( * * TclCreateLateExitHandler -- * - * Arrange for a given function to be invoked after all pre-thread cleanups + * Arrange for a given function to be invoked after all pre-thread + * cleanups. * * Results: * None. @@ -654,9 +664,8 @@ TclCreateLateExitHandler( Tcl_ExitProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { - ExitHandler *exitPtr; + ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler)); - exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; Tcl_MutexLock(&exitMutex); @@ -678,7 +687,7 @@ TclCreateLateExitHandler( * * Side effects: * If there is an exit handler corresponding to proc and clientData then - * it is cancelled; if no such handler exists then nothing happens. + * it is canceled; if no such handler exists then nothing happens. * *---------------------------------------------------------------------- */ @@ -700,7 +709,7 @@ Tcl_DeleteExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree((char *) exitPtr); + ckfree(exitPtr); break; } } @@ -720,8 +729,8 @@ Tcl_DeleteExitHandler( * None. * * Side effects: - * If there is a late exit handler corresponding to proc and clientData then - * it is canceled; if no such handler exists then nothing happens. + * If there is a late exit handler corresponding to proc and clientData + * then it is canceled; if no such handler exists then nothing happens. * *---------------------------------------------------------------------- */ @@ -743,7 +752,7 @@ TclDeleteLateExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree((char *) exitPtr); + ckfree(exitPtr); break; } } @@ -777,7 +786,7 @@ Tcl_CreateThreadExitHandler( ExitHandler *exitPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler)); + exitPtr = ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; exitPtr->nextPtr = tsdPtr->firstExitPtr; @@ -797,7 +806,7 @@ Tcl_CreateThreadExitHandler( * * Side effects: * If there is an exit handler corresponding to proc and clientData then - * it is cancelled; if no such handler exists then nothing happens. + * it is canceled; if no such handler exists then nothing happens. * *---------------------------------------------------------------------- */ @@ -819,7 +828,7 @@ Tcl_DeleteThreadExitHandler( } else { prevPtr->nextPtr = exitPtr->nextPtr; } - ckfree((char *) exitPtr); + ckfree(exitPtr); return; } } @@ -861,6 +870,49 @@ Tcl_SetExitProc( return prevExitProc; } + + +/* + *---------------------------------------------------------------------- + * + * InvokeExitHandlers -- + * + * Call the registered exit handlers. + * + * Results: + * None. + * + * Side effects: + * The exit handlers are invoked, and the ExitHandler struct is + * freed. + * + *---------------------------------------------------------------------- + */ +static void +InvokeExitHandlers(void) +{ + ExitHandler *exitPtr; + + Tcl_MutexLock(&exitMutex); + inExit = 1; + + for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) { + /* + * Be careful to remove the handler from the list before invoking its + * callback. This protects us against double-freeing if the callback + * should call Tcl_DeleteExitHandler on itself. + */ + + firstExitPtr = exitPtr->nextPtr; + Tcl_MutexUnlock(&exitMutex); + exitPtr->proc(exitPtr->clientData); + ckfree(exitPtr); + Tcl_MutexLock(&exitMutex); + } + firstExitPtr = NULL; + Tcl_MutexUnlock(&exitMutex); +} + /* *---------------------------------------------------------------------- @@ -896,14 +948,30 @@ Tcl_Exit( * returns, so critical is this dependcy. */ - currentAppExitPtr((ClientData) INT2PTR(status)); + currentAppExitPtr(INT2PTR(status)); Tcl_Panic("AppExitProc returned unexpectedly"); } else { /* * Use default handling. */ - Tcl_Finalize(); + InvokeExitHandlers(); + + /* + * Ensure the thread-specific data is initialised as it is used in + * Tcl_FinalizeThread() + */ + + (void) TCL_TSD_INIT(&dataKey); + + /* + * Now finalize the calling thread only (others are not safely + * reachable). Among other things, this triggers a flush of the + * Tcl_Channels that may have data enqueued. + */ + + Tcl_FinalizeThread(); + TclpExit(status); Tcl_Panic("OS exit failed!"); } @@ -937,8 +1005,8 @@ Tcl_Exit( void TclInitSubsystems(void) { - if (inFinalize != 0) { - Tcl_Panic("TclInitSubsystems called while finalizing"); + if (inExit != 0) { + Tcl_Panic("TclInitSubsystems called while exiting"); } if (subsystemsInitialized == 0) { @@ -974,12 +1042,12 @@ TclInitSubsystems(void) TclpInitPlatform(); /* Creates signal handler(s) */ TclInitDoubleConversion(); /* Initializes constants for * converting to/from double. */ - TclInitObjSubsystem(); /* Register obj types, create + TclInitObjSubsystem(); /* Register obj types, create * mutexes. */ TclInitIOSubsystem(); /* Inits a tsd key (noop). */ TclInitEncodingSubsystem(); /* Process wide encoding init. */ TclpSetInterfaces(); - TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ + TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ } TclpInitUnlock(); } @@ -992,8 +1060,8 @@ TclInitSubsystems(void) * Tcl_Finalize -- * * Shut down Tcl. First calls registered exit handlers, then carefully - * shuts down various subsystems. Called by Tcl_Exit or when the Tcl - * shared library is being unloaded. + * shuts down various subsystems. Should be invoked by user before the + * Tcl shared library is being unloaded in an embedded context. * * Results: * None. @@ -1013,23 +1081,7 @@ Tcl_Finalize(void) * Invoke exit handlers first. */ - Tcl_MutexLock(&exitMutex); - inFinalize = 1; - for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) { - /* - * Be careful to remove the handler from the list before invoking its - * callback. This protects us against double-freeing if the callback - * should call Tcl_DeleteExitHandler on itself. - */ - - firstExitPtr = exitPtr->nextPtr; - Tcl_MutexUnlock(&exitMutex); - (*exitPtr->proc)(exitPtr->clientData); - ckfree((char *) exitPtr); - Tcl_MutexLock(&exitMutex); - } - firstExitPtr = NULL; - Tcl_MutexUnlock(&exitMutex); + InvokeExitHandlers(); TclpInitLock(); if (subsystemsInitialized == 0) { @@ -1058,7 +1110,8 @@ Tcl_Finalize(void) */ Tcl_MutexLock(&exitMutex); - for (exitPtr = firstLateExitPtr; exitPtr != NULL; exitPtr = firstLateExitPtr) { + for (exitPtr = firstLateExitPtr; exitPtr != NULL; + exitPtr = firstLateExitPtr) { /* * Be careful to remove the handler from the list before invoking its * callback. This protects us against double-freeing if the callback @@ -1068,7 +1121,7 @@ Tcl_Finalize(void) firstLateExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); exitPtr->proc(exitPtr->clientData); - ckfree((char *) exitPtr); + ckfree(exitPtr); Tcl_MutexLock(&exitMutex); } firstLateExitPtr = NULL; @@ -1079,6 +1132,7 @@ Tcl_Finalize(void) * after the exit handlers, because there are order dependencies. */ + TclFinalizeEvaluation(); TclFinalizeExecution(); TclFinalizeEnvironment(); @@ -1134,10 +1188,10 @@ Tcl_Finalize(void) /* * There have been several bugs in the past that cause exit handlers to be * established during Tcl_Finalize processing. Such exit handlers leave - * malloc'ed memory, and Tcl_FinalizeThreadAlloc or - * Tcl_FinalizeMemorySubsystem will result in a corrupted heap. The result - * can be a mysterious crash on process exit. Check here that nobody's - * done this. + * malloc'ed memory, and Tcl_FinalizeMemorySubsystem or + * Tcl_FinalizeThreadAlloc will result in a corrupted heap. The result can + * be a mysterious crash on process exit. Check here that nobody's done + * this. */ if (firstExitPtr != NULL) { @@ -1184,7 +1238,6 @@ Tcl_Finalize(void) */ TclFinalizeMemorySubsystem(); - inFinalize = 0; alreadyFinalized: TclFinalizeLock(); @@ -1219,7 +1272,7 @@ Tcl_FinalizeThread(void) * initialized already. */ - tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + tsdPtr = TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { tsdPtr->inExit = 1; @@ -1232,8 +1285,8 @@ Tcl_FinalizeThread(void) */ tsdPtr->firstExitPtr = exitPtr->nextPtr; - (*exitPtr->proc)(exitPtr->clientData); - ckfree((char *) exitPtr); + exitPtr->proc(exitPtr->clientData); + ckfree(exitPtr); } TclFinalizeIOSubsystem(); TclFinalizeNotifier(); @@ -1273,7 +1326,7 @@ Tcl_FinalizeThread(void) int TclInExit(void) { - return inFinalize; + return inExit; } /* @@ -1295,13 +1348,12 @@ TclInExit(void) int TclInThreadExit(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); + if (tsdPtr == NULL) { return 0; - } else { - return tsdPtr->inExit; } + return tsdPtr->inExit; } /* @@ -1327,10 +1379,10 @@ Tcl_VwaitObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int done, foundEvent; - char *nameString; + const char *nameString; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); @@ -1339,36 +1391,48 @@ Tcl_VwaitObjCmd( nameString = Tcl_GetString(objv[1]); if (Tcl_TraceVar(interp, nameString, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - VwaitVarProc, (ClientData) &done) != TCL_OK) { + VwaitVarProc, &done) != TCL_OK) { return TCL_ERROR; }; done = 0; foundEvent = 1; while (!done && foundEvent) { foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS); + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + break; + } if (Tcl_LimitExceeded(interp)) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "limit exceeded", NULL); break; } } Tcl_UntraceVar(interp, nameString, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - VwaitVarProc, (ClientData) &done); + VwaitVarProc, &done); - /* - * Clear out the interpreter's result, since it may have been set by event - * handlers. - */ - - Tcl_ResetResult(interp); if (!foundEvent) { + Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't wait for variable \"", nameString, "\": would wait forever", NULL); + Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL); return TCL_ERROR; } if (!done) { - Tcl_AppendResult(interp, "limit exceeded", NULL); + /* + * The interpreter's result was already set to the right error message + * prior to exiting the loop above. + */ + return TCL_ERROR; } + + /* + * Clear out the interpreter's result, since it may have been set by event + * handlers. + */ + + Tcl_ResetResult(interp); return TCL_OK; } @@ -1377,11 +1441,11 @@ static char * VwaitVarProc( ClientData clientData, /* Pointer to integer to set to 1. */ Tcl_Interp *interp, /* Interpreter containing variable. */ - CONST char *name1, /* Name of variable. */ - CONST char *name2, /* Second part of variable name. */ + const char *name1, /* Name of variable. */ + const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { - int *donePtr = (int *) clientData; + int *donePtr = clientData; *donePtr = 1; return NULL; @@ -1410,11 +1474,11 @@ Tcl_UpdateObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { int optionIndex; int flags = 0; /* Initialized to avoid compiler warning. */ - static CONST char *updateOptions[] = {"idletasks", NULL}; + static const char *const updateOptions[] = {"idletasks", NULL}; enum updateOptions {REGEXP_IDLETASKS}; if (objc == 1) { @@ -1437,6 +1501,9 @@ Tcl_UpdateObjCmd( } while (Tcl_DoOneEvent(flags) != 0) { + if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { + return TCL_ERROR; + } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "limit exceeded", NULL); @@ -1455,11 +1522,11 @@ Tcl_UpdateObjCmd( #ifdef TCL_THREADS /* - *----------------------------------------------------------------------------- + *---------------------------------------------------------------------- * * NewThreadProc -- * - * Bootstrap function of a new Tcl thread. + * Bootstrap function of a new Tcl thread. * * Results: * None. @@ -1467,23 +1534,22 @@ Tcl_UpdateObjCmd( * Side Effects: * Initializes Tcl notifier for the current thread. * - *----------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ static Tcl_ThreadCreateType NewThreadProc( ClientData clientData) { - ThreadClientData *cdPtr; + ThreadClientData *cdPtr = clientData; ClientData threadClientData; Tcl_ThreadCreateProc *threadProc; - cdPtr = (ThreadClientData *) clientData; threadProc = cdPtr->proc; threadClientData = cdPtr->clientData; - ckfree((char *) clientData); /* Allocated in Tcl_CreateThread() */ + ckfree(clientData); /* Allocated in Tcl_CreateThread() */ - (*threadProc)(threadClientData); + threadProc(threadClientData); TCL_THREAD_CREATE_RETURN; } @@ -1511,21 +1577,23 @@ NewThreadProc( int Tcl_CreateThread( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ - Tcl_ThreadCreateProc proc, /* Main() function of the thread */ + Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ ClientData clientData, /* The one argument to Main() */ int stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { #ifdef TCL_THREADS - ThreadClientData *cdPtr; + ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData)); + int result; - cdPtr = (ThreadClientData *) ckalloc(sizeof(ThreadClientData)); cdPtr->proc = proc; cdPtr->clientData = clientData; - - return TclpThreadCreate(idPtr, NewThreadProc, (ClientData) cdPtr, - stackSize, flags); + result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags); + if (result != TCL_OK) { + ckfree(cdPtr); + } + return result; #else return TCL_ERROR; #endif /* TCL_THREADS */ |