diff options
author | Joe Mistachkin <joe@mistachkin.com> | 2008-06-13 05:45:01 (GMT) |
---|---|---|
committer | Joe Mistachkin <joe@mistachkin.com> | 2008-06-13 05:45:01 (GMT) |
commit | f7c3c0f0809266035acb3cdeaa624f903a3b0cf0 (patch) | |
tree | 32ea63055bc449e3ffe1e3b813bb8c48326ac84c /generic/tclEvent.c | |
parent | 9c5b16baabde8f28eb258e1b9be4727afa812830 (diff) | |
download | tcl-f7c3c0f0809266035acb3cdeaa624f903a3b0cf0.zip tcl-f7c3c0f0809266035acb3cdeaa624f903a3b0cf0.tar.gz tcl-f7c3c0f0809266035acb3cdeaa624f903a3b0cf0.tar.bz2 |
TIP 285 Implementation
Diffstat (limited to 'generic/tclEvent.c')
-rw-r--r-- | generic/tclEvent.c | 35 |
1 files changed, 24 insertions, 11 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 7a7dbd8..836d958 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.81 2008/04/27 22:21:29 dkf Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.82 2008/06/13 05:45:10 mistachkin Exp $ */ #include "tclInt.h" @@ -571,7 +571,7 @@ TclGetBgErrorHandler( * * Side effects: * Background error information is freed: if there were any pending error - * reports, they are cancelled. + * reports, they are canceled. * *---------------------------------------------------------------------- */ @@ -643,7 +643,7 @@ Tcl_CreateExitHandler( * * 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. * *---------------------------------------------------------------------- */ @@ -719,7 +719,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. * *---------------------------------------------------------------------- */ @@ -980,6 +980,7 @@ Tcl_Finalize(void) * after the exit handlers, because there are order dependencies. */ + TclFinalizeEvaluation(); TclFinalizeExecution(); TclFinalizeEnvironment(); @@ -1246,7 +1247,12 @@ Tcl_VwaitObjCmd( 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; } } @@ -1254,20 +1260,24 @@ Tcl_VwaitObjCmd( TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, (ClientData) &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); 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; + } else { + /* + * Clear out the interpreter's result, since it may have been + * set by event handlers. + */ + Tcl_ResetResult(interp); } return TCL_OK; } @@ -1337,6 +1347,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); |