TIP 285 Implementation

1 files changed, 38 insertions, 5 deletions

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 5bbc366..6e0d0d3 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -9,11 +9,12 @@
  * Copyright (c) 2002-2005 by Miguel Sofer.
  * Copyright (c) 2005-2007 by Donal K. Fellows.
  * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+ * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.372 2008/06/08 03:21:33 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.373 2008/06/13 05:45:10 mistachkin Exp $
  */
 
 #include "tclInt.h"
@@ -1411,12 +1412,19 @@ TclCompEvalObj(
      * performance is noticeable.
      */
 
+    TclResetCancellation(interp, 0);
+
     iPtr->numLevels++;
     if (TclInterpReady(interp) == TCL_ERROR) {
 	result = TCL_ERROR;
 	goto done;
     }
 
+    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+	result = TCL_ERROR;
+	goto done;
+    }
+
     namespacePtr = iPtr->varFramePtr->nsPtr;
 
     /*
@@ -1880,10 +1888,9 @@ TclExecuteByteCode(
 	 * Check for asynchronous handlers [Bug 746722]; we do the check every
 	 * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-<1).
 	 */
-
-	if (TclAsyncReady(iPtr)) {
 	    int localResult;
 
+	if (TclAsyncReady(iPtr)) {
 	    DECACHE_STACK_INFO();
 	    localResult = Tcl_AsyncInvoke(interp, result);
 	    CACHE_STACK_INFO();
@@ -1892,10 +1899,18 @@ TclExecuteByteCode(
 		goto checkForCatch;
 	    }
 	}
-	if (TclLimitReady(iPtr->limit)) {
-	    int localResult;
 
 	    DECACHE_STACK_INFO();
+	localResult = Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG);
+	CACHE_STACK_INFO();
+
+	if (localResult == TCL_ERROR) {
+		result = TCL_ERROR;
+		goto checkForCatch;
+	}
+
+	if (TclLimitReady(iPtr->limit)) {
+	    DECACHE_STACK_INFO();
 	    localResult = Tcl_LimitCheck(interp);
 	    CACHE_STACK_INFO();
 	    if (localResult == TCL_ERROR) {
@@ -7302,6 +7317,24 @@ TclExecuteByteCode(
 	}
 
 	/*
+	 * We must not catch if the script in progress has been canceled with
+	 * the TCL_CANCEL_UNWIND flag.  Instead, it blows outwards until we
+	 * either hit another interpreter (presumably where the script in
+	 * progress has not been canceled) or we get to the top-level.  We
+	 * do NOT modify the interpreter result here because we know it will
+	 * already be set prior to vectoring down to this point in the code.
+	 */
+	if (Tcl_Canceled(interp, 0) == TCL_ERROR) {
+#ifdef TCL_COMPILE_DEBUG
+	    if (traceInstructions) {
+		fprintf(stdout, "   ... cancel with unwind, returning %s\n",
+			StringForResultCode(result));
+	    }
+#endif
+	    goto abnormalReturn;
+	}
+
+	/*
 	 * We must not catch an exceeded limit. Instead, it blows outwards
 	 * until we either hit another interpreter (presumably where the limit
 	 * is not exceeded) or we get to the top-level.