summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclBasic.c9
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclInterp.c3
-rw-r--r--generic/tclNamesp.c5
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,