diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2009-03-21 09:42:06 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2009-03-21 09:42:06 (GMT) |
commit | 61861981e390fd931fe6af2bb3fa9b2d984eb307 (patch) | |
tree | e8e1c28643010bdcc4334464e09bcae493800483 /generic/tclBasic.c | |
parent | 0a098f986c82c3df2107386ae53a6e40da726c27 (diff) | |
download | tcl-61861981e390fd931fe6af2bb3fa9b2d984eb307.zip tcl-61861981e390fd931fe6af2bb3fa9b2d984eb307.tar.gz tcl-61861981e390fd931fe6af2bb3fa9b2d984eb307.tar.bz2 |
* generic/tclBasic.c: Fix for (among others) [Bug 2699087]
* generic/tclCmdAH.c: Tailcalls now perform properly even from
* generic/tclExecute.c: within [eval]ed scripts.
* generic/tclInt.h: More tests missing, as well as proper
exploration and testing of the interaction with "redirectors" like
interp-alias (suspect that it does not happen in constant space)
and pure-eval commands.
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 56 |
1 files changed, 33 insertions, 23 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 739732f..c40cd49 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.388 2009/03/19 23:31:37 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.389 2009/03/21 09:42:06 msofer Exp $ */ #include "tclInt.h" @@ -7988,8 +7988,9 @@ TclNRTailcallObjCmd( { Interp *iPtr = (Interp *) interp; TEOV_callback *tailcallPtr; - Tcl_Obj *listPtr; - Namespace *nsPtr = iPtr->varFramePtr->nsPtr; + Tcl_Obj *listPtr, *nsObjPtr; + Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; + Tcl_Namespace *ns1Ptr; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); @@ -8004,10 +8005,16 @@ TclNRTailcallObjCmd( return TCL_ERROR; } - nsPtr->activationCount++; listPtr = Tcl_NewListObj(objc-1, objv+1); Tcl_IncrRefCount(listPtr); + nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); + if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr)) + || (nsPtr != ns1Ptr)) { + Tcl_Panic("Tailcall failed to find the proper namespace"); + } + Tcl_IncrRefCount(nsObjPtr); + /* * Add two callbacks: first the one to actually evaluate the tailcalled * command, then the one that signals TEBC to stash the first at its @@ -8017,7 +8024,7 @@ TclNRTailcallObjCmd( * TclNRAddCallBack macro to build the callback) */ - TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, NULL, NULL); + TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL); tailcallPtr = TOP_CB(interp); TOP_CB(interp) = tailcallPtr->nextPtr; @@ -8033,27 +8040,19 @@ NRTailcallEval( { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = data[0]; - Namespace *nsPtr = data[1]; - int omit = PTR2INT(data[2]); + Tcl_Obj *nsObjPtr = data[1]; + Tcl_Namespace *nsPtr; int objc; Tcl_Obj **objv; - TclNRDeferCallback(interp, TailcallCleanup, listPtr, NULL, NULL, NULL); - if (!omit && (result == TCL_OK)) { - iPtr->lookupNsPtr = nsPtr; - ListObjGetElements(listPtr, objc, objv); - result = TclNREvalObjv(interp, objc, objv, 0, NULL); - } - - nsPtr->activationCount--; - if ((nsPtr->flags & NS_DYING) - && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) { - /* - * FIXME NRE tailcall: is this the proper way to manage this? This is - * like what CallFrames do. - */ - - Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); + TclNRDeferCallback(interp, TailcallCleanup, listPtr, nsObjPtr, NULL, NULL); + if (result == TCL_OK) { + result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); + if (result == TCL_OK) { + iPtr->lookupNsPtr = (Namespace *) nsPtr; + ListObjGetElements(listPtr, objc, objv); + result = TclNREvalObjv(interp, objc, objv, 0, NULL); + } } return result; } @@ -8065,8 +8064,19 @@ TailcallCleanup( int result) { Tcl_DecrRefCount((Tcl_Obj *) data[0]); + Tcl_DecrRefCount((Tcl_Obj *) data[1]); return result; } + +void +TclClearTailcall( + Tcl_Interp *interp, + TEOV_callback *tailcallPtr) +{ + TailcallCleanup(tailcallPtr->data, interp, TCL_OK); + TCLNR_FREE(interp, tailcallPtr); +} + void Tcl_NRAddCallback( |