From eab20b1515b9e3c6dfa404b57482ef34429d1a63 Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Fri, 5 Sep 2008 01:19:55 +0000
Subject: 	* generic/tclTrace.test (TraceVarProc): 	*
 generic/unsupported.test: insure that unset traces are run even 	when
 the coroutine is unwinding [Bug 2093947]

---
 ChangeLog              |  4 ++++
 generic/tclTrace.c     | 17 +++++++++++++++--
 tests/unsupported.test | 27 ++++++++++++++++++++++++++-
 3 files changed, 45 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 6360fb4..6e7a9d8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2008-09-04  Miguel Sofer  <msofer@users.sf.net>
 
+	* generic/tclTrace.test (TraceVarProc):
+	* generic/unsupported.test: insure that unset traces are run even
+	when the coroutine is unwinding [Bug 2093947]
+	
 	* generic/tclExecute.c (CACHE_STACK_INFO): 
 	* tests/unsupported.test:  restore the execEnv's bottomPtr, fix
 	for [Bug 2093188]. 
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index bb4dbfa..8f095b5 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTrace.c,v 1.50 2008/08/07 22:29:09 nijtmans Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.51 2008/09/05 01:20:00 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1947,7 +1947,8 @@ TraceVarProc(
     char *result;
     int code, destroy = 0;
     Tcl_DString cmd;
-
+    int rewind = ((Interp *)interp)->execEnvPtr->rewind;
+    
     /*
      * We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
      * which might try to free tvarPtr. We want to use tvarPtr until the end
@@ -2008,8 +2009,20 @@ TraceVarProc(
 		destroy = 1;
 		tvarPtr->flags |= TCL_TRACE_DESTROYED;
 	    }
+
+	    /*
+	     * Make sure that unset traces are rune even if the execEnv is
+	     * rewinding (coroutine deletion, [Bug 2093947]
+	     */
+
+	    if (rewind && (flags & TCL_TRACE_UNSETS)) {
+		((Interp *)interp)->execEnvPtr->rewind = 0;
+	    }
 	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
 		    Tcl_DStringLength(&cmd), 0);
+	    if (rewind) {
+		((Interp *)interp)->execEnvPtr->rewind = rewind;
+	    }
 	    if (code != TCL_OK) {		/* copy error msg to result */
 		Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
 		Tcl_IncrRefCount(errMsgObj);
diff --git a/tests/unsupported.test b/tests/unsupported.test
index 2c1a281..74f91aa 100644
--- a/tests/unsupported.test
+++ b/tests/unsupported.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: unsupported.test,v 1.9 2008/09/04 16:34:55 msofer Exp $
+# RCS: @(#) $Id: unsupported.test,v 1.10 2008/09/05 01:20:01 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -810,6 +810,31 @@ test unsupported-C.4.2 {bug #2093188} -constraints {coroutine} \
     unset ::res
 } -result {{} 3 {{v {} read} {v {} unset}}}
 
+test unsupported-C.4.2 {bug #2093947} -constraints {coroutine} \
+-setup {
+    proc foo {} {
+	set v 1
+	trace add variable v {write unset} bar
+	yield
+	set v 2
+	yield
+	set v 3
+    }
+    proc bar args {lappend ::res $args}
+} -body {
+    coroutine a foo
+    a
+    a
+    coroutine a foo
+    a
+    rename a {}
+    set ::res
+} -cleanup {
+    rename foo {}
+    rename bar {}
+    unset ::res
+} -result {{v {} write} {v {} write} {v {} unset} {v {} write} {v {} unset}}
+
 # cleanup
 ::tcltest::cleanupTests
 
-- 
cgit v0.12