summaryrefslogtreecommitdiffstats
path: root/generic/tclEvent.c
diff options
context:
space:
mode:
authorJoe Mistachkin <joe@mistachkin.com>2008-06-13 05:45:01 (GMT)
committerJoe Mistachkin <joe@mistachkin.com>2008-06-13 05:45:01 (GMT)
commitf7c3c0f0809266035acb3cdeaa624f903a3b0cf0 (patch)
tree32ea63055bc449e3ffe1e3b813bb8c48326ac84c /generic/tclEvent.c
parent9c5b16baabde8f28eb258e1b9be4727afa812830 (diff)
downloadtcl-f7c3c0f0809266035acb3cdeaa624f903a3b0cf0.zip
tcl-f7c3c0f0809266035acb3cdeaa624f903a3b0cf0.tar.gz
tcl-f7c3c0f0809266035acb3cdeaa624f903a3b0cf0.tar.bz2
TIP 285 Implementation
Diffstat (limited to 'generic/tclEvent.c')
-rw-r--r--generic/tclEvent.c35
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);