From 0365b12800ffbe88c8cf5c5cea0b43421ba90617 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 24 May 2016 19:28:50 +0000 Subject: Appears that the TclInitRewriteEnsemble() routine was created with an intent to refactor, but never actually got used. Work on continuing that effort. FossilOrigin-Name: fa57c51bbb981b74702654e0017926ed610b9691 --- generic/tclBasic.c | 6 ++---- generic/tclEnsemble.c | 19 ++++++++++++++++++- generic/tclExecute.c | 8 +++++--- generic/tclNamesp.c | 1 + generic/tclOOMethod.c | 1 + generic/tclProc.c | 2 ++ 6 files changed, 29 insertions(+), 8 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e5d7406..b0c31cc 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -723,9 +723,7 @@ Tcl_CreateInterp(void) * Initialize the ensemble error message rewriting support. */ - iPtr->ensembleRewrite.sourceObjs = NULL; - iPtr->ensembleRewrite.numRemovedObjs = 0; - iPtr->ensembleRewrite.numInsertedObjs = 0; + TclResetRewriteEnsemble(interp, 1); /* * TIP#143: Initialise the resource limit support. @@ -4220,7 +4218,7 @@ EvalObjvCore( * TCL_EVAL_INVOKE was not set: clear rewrite rules */ - iPtr->ensembleRewrite.sourceObjs = NULL; + TclResetRewriteEnsemble(interp, 1); if (flags & TCL_EVAL_GLOBAL) { TEOV_SwitchVarFrame(interp); diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 986a553..f108030 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1876,6 +1876,15 @@ NsEnsembleImplementationCmdNR( * count both as inserted and removed arguments. */ +#if 1 + if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters, + prefixObjc + ensemblePtr->numParameters, objv)) { + TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, + NULL); + } + +#else + if (iPtr->ensembleRewrite.sourceObjs == NULL) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = @@ -1890,6 +1899,7 @@ NsEnsembleImplementationCmdNR( /* Position in objv of new front of insertion * relative to old one. */ if (ni > 0) { +//fprintf(stdout, "COVER\n"); fflush(stdout); iPtr->ensembleRewrite.numRemovedObjs += ni; iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1; } else { @@ -1897,6 +1907,8 @@ NsEnsembleImplementationCmdNR( } } +#endif + /* * Hand off to the target command. */ @@ -2005,15 +2017,20 @@ TclInitRewriteEnsemble( int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); if (isRootEnsemble) { +//fprintf(stdout, "SET-SOURCE: '%s'\n", Tcl_GetString(objv[0])); fflush(stdout); iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = numRemoved; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { int numIns = iPtr->ensembleRewrite.numInsertedObjs; +//fprintf(stdout, "Pre-SOURCE: '%s'\n", +//Tcl_GetString(iPtr->ensembleRewrite.sourceObjs[0])); fflush(stdout); + if (numIns < numRemoved) { +//fprintf(stdout, "COVER2\n"); fflush(stdout); iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns; - iPtr->ensembleRewrite.numInsertedObjs += numInserted - 1; + iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d4077f5..80598c1 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3172,9 +3172,11 @@ TEBCresume( if (iPtr->flags & INTERP_DEBUG_FRAME) { ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); } - iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = opnd; - iPtr->ensembleRewrite.numInsertedObjs = 1; + + if (!TclInitRewriteEnsemble(interp, opnd, 1, objv)) { +//fprintf(stdout, "INVOKE: '%s'\n", Tcl_GetString(objPtr)); fflush(stdout); + Tcl_Panic("INST_INVOKE_REPLACE is not ensemble root"); + } DECACHE_STACK_INFO(); pc += 6; TEBC_YIELD(); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 58a86d9..bad408e 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -3362,6 +3362,7 @@ NRNamespaceEvalCmd( - iPtr->ensembleRewrite.numInsertedObjs; framePtr->objv = iPtr->ensembleRewrite.sourceObjs; } + TclResetRewriteEnsemble(interp, 1); if (objc == 3) { /* diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 34fa108..b86a203 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -732,6 +732,7 @@ InvokeProcedureMethod( * Now invoke the body of the method. */ +//fprintf(stdout, "eh? %p\n", ((Interp *)interp)->ensembleRewrite.sourceObjs); fflush(stdout); TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL); return TclNRInterpProcCore(interp, fdPtr->nameObj, Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc); diff --git a/generic/tclProc.c b/generic/tclProc.c index 172b860..1a3bdb7 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1786,6 +1786,8 @@ TclNRInterpProcCore( * Invoke the commands in the procedure's body. */ + TclResetRewriteEnsemble(interp, 1); + procPtr->refCount++; codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; -- cgit v0.12 From 190345fde7fcb379e356b2bad93a1f78b6d0ebbc Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 24 May 2016 19:29:58 +0000 Subject: The handling of ensemble rewriting here is not right, but I've not yet found the test case to demonstrate it. Checking in debugging code to spread to other dev platforms. FossilOrigin-Name: 6ede6094da52b6e88418b1a99a4f92220a479033 --- generic/tclEnsemble.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 986a553..c947459 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -12,6 +12,7 @@ #include "tclInt.h" #include "tclCompile.h" +#include "assert.h" /* * Declarations for functions local to this file: @@ -1891,6 +1892,12 @@ NsEnsembleImplementationCmdNR( * relative to old one. */ if (ni > 0) { iPtr->ensembleRewrite.numRemovedObjs += ni; +fprintf(stdout, "%d == %d\n", +iPtr->ensembleRewrite.numInsertedObjs - 1, +ensemblePtr->numParameters); +fflush(stdout); +assert(iPtr->ensembleRewrite.numInsertedObjs - 1 == ensemblePtr->numParameters); + iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1; } else { iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2; -- cgit v0.12 From 162c2b4f15eca162a8990802be15f35556440fda Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 24 May 2016 20:16:10 +0000 Subject: New test namespace-53.11 demonstrates the bug. FossilOrigin-Name: bde7b8bc534ccb960cc0169a991d233e42bb68da --- generic/tclEnsemble.c | 8 +------- tests/namespace.test | 16 ++++++++++++++++ 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index c947459..c85828b 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -12,7 +12,6 @@ #include "tclInt.h" #include "tclCompile.h" -#include "assert.h" /* * Declarations for functions local to this file: @@ -1892,13 +1891,8 @@ NsEnsembleImplementationCmdNR( * relative to old one. */ if (ni > 0) { iPtr->ensembleRewrite.numRemovedObjs += ni; -fprintf(stdout, "%d == %d\n", -iPtr->ensembleRewrite.numInsertedObjs - 1, -ensemblePtr->numParameters); -fflush(stdout); -assert(iPtr->ensembleRewrite.numInsertedObjs - 1 == ensemblePtr->numParameters); - iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1; +// iPtr->ensembleRewrite.numInsertedObjs = prefixObjc + ensemblePtr->numParameters; } else { iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2; } diff --git a/tests/namespace.test b/tests/namespace.test index cb9bc8c..2ba695a 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -2928,6 +2928,22 @@ test namespace-53.10 {ensembles: nested rewrite} -setup { 0 {1 v}\ 1 {wrong # args: should be "ns v x z2 a2"}\ 0 {2 v v2}} +test namespace-53.11 {ensembles: nested rewrite} -setup { + namespace eval ns { + namespace export x + namespace eval x { + proc z2 {a1 a2} {list 2 $a1 $a2} + namespace export z* + namespace ensemble create -parameter p + } + namespace ensemble create + } +} -body { + list [catch {ns x 1 z2} msg] $msg +} -cleanup { + namespace delete ns + unset -nocomplain msg +} -result {1 {wrong # args: should be "ns x 1 z2 a2"}} test namespace-54.1 {leak on namespace deletion} -constraints {memory} \ -setup { -- cgit v0.12 From 6d7b1bda316968e3542c5eae8d04bdd3109c9327 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 24 May 2016 20:23:15 +0000 Subject: Now fix the bug. FossilOrigin-Name: 4d9863515fd75f56bdeea53dd1d9c821ea22f489 --- generic/tclEnsemble.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index c85828b..7ef8042 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1891,8 +1891,8 @@ NsEnsembleImplementationCmdNR( * relative to old one. */ if (ni > 0) { iPtr->ensembleRewrite.numRemovedObjs += ni; - iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1; -// iPtr->ensembleRewrite.numInsertedObjs = prefixObjc + ensemblePtr->numParameters; + iPtr->ensembleRewrite.numInsertedObjs + = prefixObjc + ensemblePtr->numParameters; } else { iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2; } -- cgit v0.12 From 654f70b8075f6cd989aa4dafd003596cd54ecdc8 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 24 May 2016 20:39:25 +0000 Subject: Adapt and tidy up the bug fix. FossilOrigin-Name: f6855ab1bac98ea7b2a9e39526f9a0b97898c216 --- generic/tclEnsemble.c | 34 ---------------------------------- 1 file changed, 34 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index e37ad1a..1c91734 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1832,7 +1832,6 @@ NsEnsembleImplementationCmdNR( Tcl_Obj *copyPtr; /* The actual list of words to dispatch to. * Will be freed by the dispatch engine. */ int prefixObjc, copyObjc; - Interp *iPtr = (Interp *) interp; /* * Get the prefix that we're rewriting to. To do this we need to @@ -1876,40 +1875,12 @@ NsEnsembleImplementationCmdNR( * count both as inserted and removed arguments. */ -#if 1 if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters, prefixObjc + ensemblePtr->numParameters, objv)) { TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } -#else - - if (iPtr->ensembleRewrite.sourceObjs == NULL) { - iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = - 2 + ensemblePtr->numParameters; - iPtr->ensembleRewrite.numInsertedObjs = - prefixObjc + ensemblePtr->numParameters; - TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, - NULL); - } else { - register int ni = 2 + ensemblePtr->numParameters - - iPtr->ensembleRewrite.numInsertedObjs; - /* Position in objv of new front of insertion - * relative to old one. */ - if (ni > 0) { -//fprintf(stdout, "COVER\n"); fflush(stdout); - iPtr->ensembleRewrite.numRemovedObjs += ni; - iPtr->ensembleRewrite.numInsertedObjs - = prefixObjc + ensemblePtr->numParameters; - } else { - iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2; - } - } - -#endif - /* * Hand off to the target command. */ @@ -2018,18 +1989,13 @@ TclInitRewriteEnsemble( int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); if (isRootEnsemble) { -//fprintf(stdout, "SET-SOURCE: '%s'\n", Tcl_GetString(objv[0])); fflush(stdout); iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = numRemoved; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { int numIns = iPtr->ensembleRewrite.numInsertedObjs; -//fprintf(stdout, "Pre-SOURCE: '%s'\n", -//Tcl_GetString(iPtr->ensembleRewrite.sourceObjs[0])); fflush(stdout); - if (numIns < numRemoved) { -//fprintf(stdout, "COVER2\n"); fflush(stdout); iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { -- cgit v0.12 From ac614fcfe563318b192bcf7a2569b36a014c1de0 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 25 May 2016 17:27:49 +0000 Subject: Refactor all iPtr->ensembleRewrite setting code into TclInitRewriteEnsemble() calls. This likely fixes many weird corner case bugs, and definitly makes future development and maintenance easier. FossilOrigin-Name: a6cab96d850fecfdaec9668267ef556d0fbd2fea --- generic/tclInterp.c | 32 ++++---------------------------- generic/tclOODefineCmds.c | 42 +++--------------------------------------- generic/tclOOMethod.c | 23 +++-------------------- generic/tclProc.c | 17 +++-------------- 4 files changed, 13 insertions(+), 101 deletions(-) diff --git a/generic/tclInterp.c b/generic/tclInterp.c index cd0dc18..66ce1e0 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1795,11 +1795,9 @@ AliasNRCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { - Interp *iPtr = (Interp *) interp; Alias *aliasPtr = clientData; int prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; - int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); Tcl_Obj *listPtr; List *listRep; int flags = TCL_EVAL_INVOKE; @@ -1831,21 +1829,7 @@ AliasNRCmd( * only the source command should show, not the full target prefix. */ - if (isRootEnsemble) { - iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = 1; - iPtr->ensembleRewrite.numInsertedObjs = prefc; - } else { - iPtr->ensembleRewrite.numInsertedObjs += prefc - 1; - } - - /* - * We are sending a 0-refCount obj, do not need a callback: it will be - * cleaned up automatically. But we may need to clear the rootEnsemble - * stuff ... - */ - - if (isRootEnsemble) { + if (TclInitRewriteEnsemble(interp, 1, prefc, objv)) { TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } TclSkipTailcall(interp); @@ -1866,7 +1850,7 @@ AliasObjCmd( Tcl_Obj **prefv, **cmdv; Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC]; Interp *tPtr = (Interp *) targetInterp; - int isRootEnsemble = (tPtr->ensembleRewrite.sourceObjs == NULL); + int isRootEnsemble; /* * Append the arguments to the command prefix and invoke the command in @@ -1896,13 +1880,7 @@ AliasObjCmd( * only the source command should show, not the full target prefix. */ - if (isRootEnsemble) { - tPtr->ensembleRewrite.sourceObjs = objv; - tPtr->ensembleRewrite.numRemovedObjs = 1; - tPtr->ensembleRewrite.numInsertedObjs = prefc; - } else { - tPtr->ensembleRewrite.numInsertedObjs += prefc - 1; - } + isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)tPtr, 1, prefc, objv); /* * Protect the target interpreter if it isn't the same as the source @@ -1925,9 +1903,7 @@ AliasObjCmd( */ if (isRootEnsemble) { - tPtr->ensembleRewrite.sourceObjs = NULL; - tPtr->ensembleRewrite.numRemovedObjs = 0; - tPtr->ensembleRewrite.numInsertedObjs = 0; + TclResetRewriteEnsemble((Tcl_Interp *)tPtr, 1); } /* diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index c880754..64209a0 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -847,7 +847,6 @@ TclOODefineObjCmd( TclDecrRefCount(objNameObj); } else { Tcl_Obj *objPtr, *obj2Ptr, **objs; - Interp *iPtr = (Interp *) interp; Tcl_Command cmd; int dummy; @@ -861,18 +860,7 @@ TclOODefineObjCmd( * the moment. Ugly! */ - if (iPtr->ensembleRewrite.sourceObjs == NULL) { - iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = 3; - iPtr->ensembleRewrite.numInsertedObjs = 1; - } else { - int ni = iPtr->ensembleRewrite.numInsertedObjs; - if (ni < 3) { - iPtr->ensembleRewrite.numRemovedObjs += 3 - ni; - } else { - iPtr->ensembleRewrite.numInsertedObjs -= 2; - } - } + TclInitRewriteEnsemble(interp, 3, 1, objv); /* * Build the list of arguments using a Tcl_Obj as a workspace. See @@ -962,7 +950,6 @@ TclOOObjDefObjCmd( TclDecrRefCount(objNameObj); } else { Tcl_Obj *objPtr, *obj2Ptr, **objs; - Interp *iPtr = (Interp *) interp; Tcl_Command cmd; int dummy; @@ -976,18 +963,7 @@ TclOOObjDefObjCmd( * the moment. Ugly! */ - if (iPtr->ensembleRewrite.sourceObjs == NULL) { - iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = 3; - iPtr->ensembleRewrite.numInsertedObjs = 1; - } else { - int ni = iPtr->ensembleRewrite.numInsertedObjs; - if (ni < 3) { - iPtr->ensembleRewrite.numRemovedObjs += 3 - ni; - } else { - iPtr->ensembleRewrite.numInsertedObjs -= 2; - } - } + TclInitRewriteEnsemble(interp, 3, 1, objv); /* * Build the list of arguments using a Tcl_Obj as a workspace. See @@ -1077,7 +1053,6 @@ TclOODefineSelfObjCmd( TclDecrRefCount(objNameObj); } else { Tcl_Obj *objPtr, *obj2Ptr, **objs; - Interp *iPtr = (Interp *) interp; Tcl_Command cmd; int dummy; @@ -1091,18 +1066,7 @@ TclOODefineSelfObjCmd( * the moment. Ugly! */ - if (iPtr->ensembleRewrite.sourceObjs == NULL) { - iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = 2; - iPtr->ensembleRewrite.numInsertedObjs = 1; - } else { - int ni = iPtr->ensembleRewrite.numInsertedObjs; - if (ni < 2) { - iPtr->ensembleRewrite.numRemovedObjs += 2 - ni; - } else { - iPtr->ensembleRewrite.numInsertedObjs -= 1; - } - } + TclInitRewriteEnsemble(interp, 2, 1, objv); /* * Build the list of arguments using a Tcl_Obj as a workspace. See diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index b86a203..843f833 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -732,7 +732,6 @@ InvokeProcedureMethod( * Now invoke the body of the method. */ -//fprintf(stdout, "eh? %p\n", ((Interp *)interp)->ensembleRewrite.sourceObjs); fflush(stdout); TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL); return TclNRInterpProcCore(interp, fdPtr->nameObj, Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc); @@ -1595,12 +1594,9 @@ InitEnsembleRewrite( int *lengthPtr) /* Where to write the resulting length of the * array of rewritten arguments. */ { - Interp *iPtr = (Interp *) interp; - int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); - Tcl_Obj **argObjs; unsigned len = rewriteLength + objc - toRewrite; + Tcl_Obj **argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len); - argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len); memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *)); memcpy(argObjs + rewriteLength, objv + toRewrite, sizeof(Tcl_Obj *) * (objc - toRewrite)); @@ -1614,22 +1610,9 @@ InitEnsembleRewrite( * (and unavoidably). */ - if (isRootEnsemble) { - iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = toRewrite; - iPtr->ensembleRewrite.numInsertedObjs = rewriteLength; - } else { - int numIns = iPtr->ensembleRewrite.numInsertedObjs; - - if (numIns < toRewrite) { - iPtr->ensembleRewrite.numRemovedObjs += toRewrite - numIns; - iPtr->ensembleRewrite.numInsertedObjs += rewriteLength - 1; - } else { - iPtr->ensembleRewrite.numInsertedObjs += - rewriteLength - toRewrite; - } + if (TclInitRewriteEnsemble(interp, toRewrite, rewriteLength, objv)) { + TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } - *lengthPtr = len; return argObjs; } diff --git a/generic/tclProc.c b/generic/tclProc.c index 1a3bdb7..56d29a2 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -22,7 +22,6 @@ */ typedef struct { - int isRootEnsemble; Command cmd; ExtraFrameInfo efi; } ApplyExtraData; @@ -2636,7 +2635,7 @@ TclNRApplyObjCmd( Interp *iPtr = (Interp *) interp; Proc *procPtr = NULL; Tcl_Obj *lambdaPtr, *nsObjPtr; - int result, isRootEnsemble; + int result; Tcl_Namespace *nsPtr; ApplyExtraData *extraPtr; @@ -2719,15 +2718,9 @@ TclNRApplyObjCmd( extraPtr->efi.fields[0].clientData = lambdaPtr; extraPtr->cmd.clientData = &extraPtr->efi; - isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); - if (isRootEnsemble) { - iPtr->ensembleRewrite.sourceObjs = objv; - iPtr->ensembleRewrite.numRemovedObjs = 1; - iPtr->ensembleRewrite.numInsertedObjs = 0; - } else { - iPtr->ensembleRewrite.numInsertedObjs -= 1; + if (TclInitRewriteEnsemble(interp, 1, 0, objv)) { + TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } - extraPtr->isRootEnsemble = isRootEnsemble; result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1); if (result == TCL_OK) { @@ -2745,10 +2738,6 @@ ApplyNR2( { ApplyExtraData *extraPtr = data[0]; - if (extraPtr->isRootEnsemble) { - ((Interp *) interp)->ensembleRewrite.sourceObjs = NULL; - } - TclStackFree(interp, extraPtr); return result; } -- cgit v0.12 From cb1a13887c35199445738e8735d333eededfb615 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 25 May 2016 18:19:27 +0000 Subject: Put in some missing Resets. FossilOrigin-Name: 19b16c1d58194bd7a9cbb31606b630555b5ae86e --- generic/tclExecute.c | 4 +++- generic/tclOODefineCmds.c | 22 ++++++++++++++++------ 2 files changed, 19 insertions(+), 7 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 80598c1..61d75cb 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3174,7 +3174,9 @@ TEBCresume( } if (!TclInitRewriteEnsemble(interp, opnd, 1, objv)) { -//fprintf(stdout, "INVOKE: '%s'\n", Tcl_GetString(objPtr)); fflush(stdout); +fprintf(stdout, "SOURCE: '%s'\n", Tcl_GetString( + ((Interp *)interp)->ensembleRewrite.sourceObjs[0])); fflush(stdout); +fprintf(stdout, "INVOKE: '%s'\n", Tcl_GetString(objPtr)); fflush(stdout); Tcl_Panic("INST_INVOKE_REPLACE is not ensemble root"); } DECACHE_STACK_INFO(); diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 64209a0..8747ff5 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -848,7 +848,7 @@ TclOODefineObjCmd( } else { Tcl_Obj *objPtr, *obj2Ptr, **objs; Tcl_Command cmd; - int dummy; + int isRoot, dummy; /* * More than one argument: fire them through the ensemble processing @@ -860,7 +860,7 @@ TclOODefineObjCmd( * the moment. Ugly! */ - TclInitRewriteEnsemble(interp, 3, 1, objv); + isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv); /* * Build the list of arguments using a Tcl_Obj as a workspace. See @@ -882,6 +882,9 @@ TclOODefineObjCmd( Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs); result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE); + if (isRoot) { + TclResetRewriteEnsemble(interp, 1); + } Tcl_DecrRefCount(objPtr); } DelRef(oPtr); @@ -915,7 +918,7 @@ TclOOObjDefObjCmd( Tcl_Obj *const *objv) { Foundation *fPtr = TclOOGetFoundation(interp); - int result; + int isRoot, result; Object *oPtr; if (objc < 3) { @@ -963,7 +966,7 @@ TclOOObjDefObjCmd( * the moment. Ugly! */ - TclInitRewriteEnsemble(interp, 3, 1, objv); + isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv); /* * Build the list of arguments using a Tcl_Obj as a workspace. See @@ -985,6 +988,10 @@ TclOOObjDefObjCmd( Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs); result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE); + + if (isRoot) { + TclResetRewriteEnsemble(interp, 1); + } Tcl_DecrRefCount(objPtr); } DelRef(oPtr); @@ -1054,7 +1061,7 @@ TclOODefineSelfObjCmd( } else { Tcl_Obj *objPtr, *obj2Ptr, **objs; Tcl_Command cmd; - int dummy; + int isRoot, dummy; /* * More than one argument: fire them through the ensemble processing @@ -1066,7 +1073,7 @@ TclOODefineSelfObjCmd( * the moment. Ugly! */ - TclInitRewriteEnsemble(interp, 2, 1, objv); + isRoot = TclInitRewriteEnsemble(interp, 2, 1, objv); /* * Build the list of arguments using a Tcl_Obj as a workspace. See @@ -1088,6 +1095,9 @@ TclOODefineSelfObjCmd( Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs); result = Tcl_EvalObjv(interp, objc-1, objs, TCL_EVAL_INVOKE); + if (isRoot) { + TclResetRewriteEnsemble(interp, 1); + } Tcl_DecrRefCount(objPtr); } DelRef(oPtr); -- cgit v0.12 From 2ed8d72bb698985282d86dace0654a2ff74d8836 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 26 May 2016 00:00:37 +0000 Subject: Another missing reset FossilOrigin-Name: dc363c186cdcef18ad9622833b5052ee41dc227c --- generic/tclNamesp.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index bad408e..543e089 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -3803,6 +3803,7 @@ NRNamespaceInscopeCmd( - iPtr->ensembleRewrite.numInsertedObjs; framePtr->objv = iPtr->ensembleRewrite.sourceObjs; } + TclResetRewriteEnsemble(interp, 1); /* * Execute the command. If there is just one argument, just treat it as a -- cgit v0.12 From 42ce795c29ac20607ce599b90ade252cd6cc38d4 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 26 May 2016 16:33:37 +0000 Subject: Reduce to minimum set of TclResetRewriteEnsemble() calls. FossilOrigin-Name: 93a5087c75337d41e0039ff291fcdc5d5652e85d --- generic/tclExecute.c | 2 ++ generic/tclNamesp.c | 2 -- generic/tclOOMethod.c | 5 +++++ generic/tclProc.c | 2 -- 4 files changed, 7 insertions(+), 4 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 61d75cb..67eabdb 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2081,6 +2081,8 @@ TclNRExecuteByteCode( * Push the callback for bytecode execution */ + TclResetRewriteEnsemble(interp, 1); + TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL, /* cleanup */ INT2PTR(0), NULL); return TCL_OK; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 543e089..58a86d9 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -3362,7 +3362,6 @@ NRNamespaceEvalCmd( - iPtr->ensembleRewrite.numInsertedObjs; framePtr->objv = iPtr->ensembleRewrite.sourceObjs; } - TclResetRewriteEnsemble(interp, 1); if (objc == 3) { /* @@ -3803,7 +3802,6 @@ NRNamespaceInscopeCmd( - iPtr->ensembleRewrite.numInsertedObjs; framePtr->objv = iPtr->ensembleRewrite.sourceObjs; } - TclResetRewriteEnsemble(interp, 1); /* * Execute the command. If there is just one argument, just treat it as a diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 843f833..a311ddb 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -1458,6 +1458,11 @@ InvokeForwardMethod( argObjs = InitEnsembleRewrite(interp, objc, objv, skip, numPrefixes, prefixObjs, &len); Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL); + /* + * NOTE: The combination of direct set of iPtr->lookupNsPtr and the use + * of the TCL_EVAL_NOERR flag results in an evaluation configuration + * very much like TCL_EVAL_INVOKE. + */ ((Interp *)interp)->lookupNsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL); diff --git a/generic/tclProc.c b/generic/tclProc.c index 56d29a2..70178f4 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1785,8 +1785,6 @@ TclNRInterpProcCore( * Invoke the commands in the procedure's body. */ - TclResetRewriteEnsemble(interp, 1); - procPtr->refCount++; codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; -- cgit v0.12 From 7c788e7fedacd0292308b01402dbf520d425eea9 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 26 May 2016 17:27:56 +0000 Subject: constructor invocation ensemble rewrite shenanigans also fit into the refactored routines. FossilOrigin-Name: f4d6cc6ad3a17be51e8fe34b6fc45c241160f665 --- generic/tclOO.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 9df5029..0454bfe 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1687,7 +1687,7 @@ Tcl_NewObjectInstance( TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL); if (contextPtr != NULL) { - int result; + int isRoot, result; Tcl_InterpState state; state = Tcl_SaveInterpState(interp, TCL_OK); @@ -1698,13 +1698,14 @@ Tcl_NewObjectInstance( * Adjust the ensmble tracking record if necessary. [Bug 3514761] */ - if (((Interp*) interp)->ensembleRewrite.sourceObjs) { - ((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1; - ((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1; - } + isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv); result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, objc, objv); + if (isRoot) { + TclResetRewriteEnsemble(interp, 1); + } + /* * It's an error if the object was whacked in the constructor. * Force this if it isn't already an error (don't want to lose @@ -1827,9 +1828,8 @@ TclNRNewObjectInstance( * Adjust the ensmble tracking record if necessary. [Bug 3514761] */ - if (((Interp *) interp)->ensembleRewrite.sourceObjs) { - ((Interp *) interp)->ensembleRewrite.numInsertedObjs += skip - 1; - ((Interp *) interp)->ensembleRewrite.numRemovedObjs += skip - 1; + if (TclInitRewriteEnsemble(interp, skip, skip, objv)) { + TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); } /* -- cgit v0.12 From 9e3603a068d375f2b812ee9616abd62080f78b02 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 26 May 2016 17:29:34 +0000 Subject: excise debug scaffolding FossilOrigin-Name: 9c07d3956aac7dba52da99ef097018e5e79426f2 --- generic/tclExecute.c | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 67eabdb..aed6a48 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3175,12 +3175,7 @@ TEBCresume( ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); } - if (!TclInitRewriteEnsemble(interp, opnd, 1, objv)) { -fprintf(stdout, "SOURCE: '%s'\n", Tcl_GetString( - ((Interp *)interp)->ensembleRewrite.sourceObjs[0])); fflush(stdout); -fprintf(stdout, "INVOKE: '%s'\n", Tcl_GetString(objPtr)); fflush(stdout); - Tcl_Panic("INST_INVOKE_REPLACE is not ensemble root"); - } + TclInitRewriteEnsemble(interp, opnd, 1, objv); DECACHE_STACK_INFO(); pc += 6; TEBC_YIELD(); -- cgit v0.12