summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdAH.c
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2009-03-21 09:42:06 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2009-03-21 09:42:06 (GMT)
commit61861981e390fd931fe6af2bb3fa9b2d984eb307 (patch)
treee8e1c28643010bdcc4334464e09bcae493800483 /generic/tclCmdAH.c
parent0a098f986c82c3df2107386ae53a6e40da726c27 (diff)
downloadtcl-61861981e390fd931fe6af2bb3fa9b2d984eb307.zip
tcl-61861981e390fd931fe6af2bb3fa9b2d984eb307.tar.gz
tcl-61861981e390fd931fe6af2bb3fa9b2d984eb307.tar.bz2
* generic/tclBasic.c: Fix for (among others) [Bug 2699087]
* generic/tclCmdAH.c: Tailcalls now perform properly even from * generic/tclExecute.c: within [eval]ed scripts. * generic/tclInt.h: More tests missing, as well as proper exploration and testing of the interaction with "redirectors" like interp-alias (suspect that it does not happen in constant space) and pure-eval commands.
Diffstat (limited to 'generic/tclCmdAH.c')
-rw-r--r--generic/tclCmdAH.c16
1 files changed, 15 insertions, 1 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index c8829f8..a00fff8 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.115 2009/02/03 23:34:33 nijtmans Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.116 2009/03/21 09:42:06 msofer Exp $
*/
#include "tclInt.h"
@@ -302,12 +302,26 @@ CatchObjCmdCallback(
Tcl_Interp *interp,
int result)
{
+ Interp *iPtr = (Interp *) interp;
int objc = PTR2INT(data[0]);
Tcl_Obj *varNamePtr = data[1];
Tcl_Obj *optionVarNamePtr = data[2];
int rewind = ((Interp *) interp)->execEnvPtr->rewind;
/*
+ * catch has to disable any tailcall
+ */
+
+ if (iPtr->varFramePtr->tailcallPtr) {
+ TclClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
+ iPtr->varFramePtr->tailcallPtr = NULL;
+ result = TCL_ERROR;
+ Tcl_SetResult(interp,"Tailcall called from within a catch environment",
+ TCL_STATIC);
+ }
+
+
+ /*
* We disable catch in interpreters where the limit has been exceeded.
*/