diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclBasic.c | 9 | ||||
| -rw-r--r-- | generic/tclInt.h | 3 | ||||
| -rw-r--r-- | generic/tclInterp.c | 3 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 5 |
5 files changed, 21 insertions, 5 deletions
@@ -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, |