From 24ad5055202aab332c748c20e2bd0471e3aab234 Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Sat, 21 Mar 2009 12:24:48 +0000
Subject: 	* generic/tclBasic.c:   fixed "leaks" in aliases, imports and 
 * generic/tclInt.h:     ensembles. Only remaining known leak 	*
 generic/tclInterp.c:  is in ensemble unknown dispatch (as it 	*
 generic/tclNamesp.c:  not NR-enabled) 	* tests/tailcall.test:

---
 ChangeLog           | 6 ++++++
 generic/tclBasic.c  | 9 +++++++--
 generic/tclInt.h    | 3 ++-
 generic/tclInterp.c | 3 ++-
 generic/tclNamesp.c | 5 ++++-
 5 files changed, 21 insertions(+), 5 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index bb6eb0d..54c7361 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2009-03-21  Miguel Sofer  <msofer@users.sf.net>
 
+	* generic/tclBasic.c:   fixed "leaks" in aliases, imports and
+	* generic/tclInt.h:     ensembles. Only remaining known leak
+	* generic/tclInterp.c:  is in ensemble unknown dispatch (as it
+	* generic/tclNamesp.c:  not NR-enabled)
+	* tests/tailcall.test:
+	
 	* tclInt.h: comments
 
 	* tests/tailcall.test: added tests to show that [tailcall] does
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c40cd49..24a1368 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.389 2009/03/21 09:42:06 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.390 2009/03/21 12:24:48 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -4058,7 +4058,12 @@ TclNREvalObjv(
      * finishes the source command and not just the target.
      */
 
-    TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+    if (iPtr->evalFlags & TCL_EVAL_REDIRECT) {
+	TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(1), NULL, NULL);
+	iPtr->evalFlags &= ~TCL_EVAL_REDIRECT;
+    } else {
+	TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
+    }
     cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]);
 
     TclNRSpliceDeferred(interp);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5c9e127..3028ff1 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.421 2009/03/21 11:46:10 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.422 2009/03/21 12:24:49 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -2086,6 +2086,7 @@ typedef struct InterpList {
 #define TCL_ALLOW_EXCEPTIONS	4
 #define TCL_EVAL_FILE		2
 #define TCL_EVAL_CTX		8
+#define TCL_EVAL_REDIRECT       16
 
 /*
  * Flag bits for Interp structures:
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 3105dc9..0972602 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.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: tclInterp.c,v 1.104 2009/02/10 22:50:04 nijtmans Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.105 2009/03/21 12:24:49 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1807,6 +1807,7 @@ AliasNRCmd(
     if (isRootEnsemble) {
 	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
     }
+    iPtr->evalFlags |= TCL_EVAL_REDIRECT;
     return Tcl_NREvalObj(interp, listPtr, flags);
 }
 
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 8caf7db..ff0bf99 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.190 2009/03/19 23:31:37 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.191 2009/03/21 12:24:49 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1938,6 +1938,7 @@ InvokeImportedNRCmd(
     ImportedCmdData *dataPtr = clientData;
     Command *realCmdPtr = dataPtr->realCmdPtr;
 
+    ((Interp *)interp)->evalFlags |= TCL_EVAL_REDIRECT;
     return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0);
 }
 
@@ -6591,6 +6592,7 @@ NsEnsembleImplementationCmdNR(
 	 * Hand off to the target command.
 	 */
 
+	iPtr->evalFlags |= TCL_EVAL_REDIRECT;	
 	return Tcl_NREvalObj(interp, copyPtr, TCL_EVAL_INVOKE);
     }
 
@@ -6726,6 +6728,7 @@ EnsembleUnknownCallback(
      */
 
     Tcl_Preserve(ensemblePtr);
+    ((Interp *)interp)->evalFlags |= TCL_EVAL_REDIRECT;    
     result = Tcl_EvalObjv(interp, paramc, paramv, 0);
     if ((result == TCL_OK) && (ensemblePtr->flags & ENS_DEAD)) {
 	Tcl_SetResult(interp,
-- 
cgit v0.12