? CORODIFF1.tmp
? DIFF
? DIFF.notest
? DIFF.testonly
? YIELDTO.diff
? tail
? yieldto.tip
? generic/tclBasic.c.CVS
? generic/tclExecute.c.1
? generic/tclExecute.c.CVS
? pkgs/itcl/itclConfig.sh
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.460
diff -u -r1.460 tclBasic.c
--- generic/tclBasic.c	11 Aug 2010 23:13:50 -0000	1.460
+++ generic/tclBasic.c	17 Aug 2010 23:43:00 -0000
@@ -8310,6 +8310,9 @@
 
   restart:
     for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
+        if (runPtr->procPtr == TclNRBlockTailcall) {
+            break;
+        }
 	if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
 	    if (!skip) {
 		break;
@@ -8333,8 +8336,19 @@
 	Tcl_Panic("Tailcall cannot find the right splicing spot: should not happen!");
     }
 
-    tailcallPtr->nextPtr = runPtr->nextPtr;
-    runPtr->nextPtr = tailcallPtr;
+    if (runPtr->procPtr == TclNRBlockTailcall) {
+        /*
+         * Attempting to tailcall out of a catch or try exception block: this
+         * is an error. Mark the blocker and clear the tailcallPtr.
+         */
+
+        iPtr->varFramePtr->tailcallPtr = NULL;
+        TclClearTailcall(interp, tailcallPtr);
+        runPtr->data[0] = INT2PTR(1);
+    } else {
+        tailcallPtr->nextPtr = runPtr->nextPtr;
+        runPtr->nextPtr = tailcallPtr;
+    }
 
     if (eePtr) {
 	/*
@@ -8444,6 +8458,32 @@
     TCLNR_FREE(interp, tailcallPtr);
 }
 
+int
+TclNRBlockTailcall(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    Interp *iPtr = (Interp *) interp;
+    int blocked = (data[0] != NULL);
+
+    if (blocked) {
+        /*
+         * A tailcall tried to escape this block, it is an error.
+         */
+
+        iPtr->varFramePtr->tailcallPtr = NULL;
+        Tcl_SetResult(interp,
+                "tailcall called from within a catch environment",
+                TCL_STATIC);
+        Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL",
+                NULL);
+        result = TCL_ERROR;
+    }
+
+    return result;
+}
+
 
 void
 Tcl_NRAddCallback(
Index: generic/tclCmdAH.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdAH.c,v
retrieving revision 1.124
diff -u -r1.124 tclCmdAH.c
--- generic/tclCmdAH.c	5 Mar 2010 14:34:03 -0000	1.124
+++ generic/tclCmdAH.c	17 Aug 2010 23:43:00 -0000
@@ -291,11 +291,18 @@
     }
 
     /*
-     * TIP #280. Make invoking context available to caught script.
+     * Add the callback to post-process the script's result and a blocker for
+     * tailcalls: you cannot tailcall out of a catch block. 
      */
 
     TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
 	    varNamePtr, optionVarNamePtr, NULL);
+    TclNRAddCallback(interp, TclNRBlockTailcall, NULL, NULL, NULL,
+	    NULL);
+    
+    /*
+     * TIP #280. Make invoking context available to caught script.
+     */
 
     return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
 }
@@ -313,19 +320,6 @@
     int rewind = iPtr->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.
      */
 
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.479
diff -u -r1.479 tclInt.h
--- generic/tclInt.h	14 Aug 2010 17:13:02 -0000	1.479
+++ generic/tclInt.h	17 Aug 2010 23:43:05 -0000
@@ -2761,6 +2761,7 @@
 MODULE_SCOPE void       TclSpliceTailcall(Tcl_Interp *interp,
 	                    struct TEOV_callback *tailcallPtr,
 	                    int skip);
+MODULE_SCOPE Tcl_NRPostProc TclNRBlockTailcall;
 
 /*
  * This structure holds the data for the various iteration callbacks used to
Index: tests/tailcall.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/tailcall.test,v
retrieving revision 1.12
diff -u -r1.12 tailcall.test
--- tests/tailcall.test	22 Jan 2010 10:22:51 -0000	1.12
+++ tests/tailcall.test	17 Aug 2010 23:43:05 -0000
@@ -557,6 +557,18 @@
     }}
 } {1 {tailcall called from within a catch environment} {TCL TAILCALL ILLEGAL}}
 
+test tailcall-12.3c {[Bug 3046594]} {
+    apply {{} {
+	list [[subst catch] [list tailcall foo] msg opt] $msg [errorcode $opt]
+    }}
+} {1 {tailcall called from within a catch environment} {TCL TAILCALL ILLEGAL}}
+
+test tailcall-12.3d {[Bug 3046594]} {
+    apply {{} {
+	list [[subst catch] {tailcall foo} msg opt] $msg [errorcode $opt]
+    }}
+} {1 {tailcall called from within a catch environment} {TCL TAILCALL ILLEGAL}}
+
 test tailcall-13.1 {tailcall and coroutine} -setup {
     set lambda {i {
 	if {$i == 1} {
