From 366828918a209f70d7d5d4d842ae100b84bdd27d 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. --- 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 535895e57716ed178153b1befbe3bbebc19eb17a 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. --- 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 7cde8a22a19b136989bd632229abc5fbb5d5836b 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. --- 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 5f7157f3a2684960a7bfc0e1f4e4499574efdbb2 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 24 May 2016 20:23:15 +0000 Subject: Now fix the bug. --- 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 f95100b44ab98d0fc64070847e52cb3dbdefb440 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. --- 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 2b502a4b2b0abd6ac80da7091c95d865abf9de9b 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. --- 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 7f43feafd571d184667bc9fcde0f71f50fb02a1d Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 25 May 2016 18:19:27 +0000 Subject: Put in some missing Resets. --- 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 d0a8ae5cf7223f7f96c2f617cf5b186fbbb2df5e Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 26 May 2016 00:00:37 +0000 Subject: Another missing reset --- 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 41a668a5156c041fb8e744d1785026b5611c0301 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. --- 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 63e94b434f939d7609e8c033d38bf40b75d02041 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. --- 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 af7e16b8e4cfccc5312e7af680e244c325e2f4ae Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 26 May 2016 17:29:34 +0000 Subject: excise debug scaffolding --- 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 From 88fc841203408d81942346c602bc76dd7a97fc3b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 29 Jun 2016 11:39:00 +0000 Subject: Tcl_SetVar -> Tcl_SetVar2 and comparable replacements, eliminating functions which are deprecated. --- .fossil-settings/ignore-glob | 2 ++ doc/AddErrInfo.3 | 2 +- generic/tclBasic.c | 8 ++++---- generic/tclCmdIL.c | 4 ++-- generic/tclIOSock.c | 2 +- generic/tclInterp.c | 12 ++++++------ generic/tclMain.c | 6 ++++-- generic/tclOO.c | 4 ++-- generic/tclParse.c | 2 +- generic/tclTest.c | 24 ++++++++++++------------ generic/tclThreadTest.c | 6 +++--- tests/event.test | 6 +++--- unix/dltest/pkgua.c | 6 +++--- unix/tclUnixInit.c | 24 ++++++++++++------------ unix/tclUnixSock.c | 2 +- win/tclWinSock.c | 2 +- 16 files changed, 58 insertions(+), 54 deletions(-) diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob index 9ed86b1..51ca1e2 100644 --- a/.fossil-settings/ignore-glob +++ b/.fossil-settings/ignore-glob @@ -17,8 +17,10 @@ */tclsh* */tcltest* */versions.vc +unix/autoMkindex.tcl unix/dltest.marker unix/tcl.pc +unix/tclIndex unix/pkgs/* win/pkgs/* win/tcl.hpj diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index caba125..0b59349 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -119,7 +119,7 @@ retrieve the stack trace when script evaluation returns \fBTCL_ERROR\fR, like so: .PP .CS -int code = Tcl_Eval(interp, script); +int code = Tcl_EvalEx(interp, script, -1, 0); if (code == TCL_ERROR) { Tcl_Obj *options = \fBTcl_GetReturnOptions\fR(interp, code); Tcl_Obj *key = Tcl_NewStringObj("-errorinfo", -1); diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 25f7e78..e3ac714 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -941,8 +941,8 @@ Tcl_CreateInterp(void) * Set up other variables such as tcl_version and tcl_library */ - Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY); Tcl_TraceVar2(interp, "tcl_precision", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, TclPrecTraceProc, NULL); @@ -6848,7 +6848,7 @@ Tcl_VarEvalVA( Tcl_DStringAppend(&buf, string, -1); } - result = Tcl_Eval(interp, Tcl_DStringValue(&buf)); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); Tcl_DStringFree(&buf); return result; } @@ -6918,7 +6918,7 @@ Tcl_GlobalEval( savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; - result = Tcl_Eval(interp, command); + result = Tcl_EvalEx(interp, command, -1, 0); iPtr->varFramePtr = savedVarFramePtr; return result; } diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c93e593..4cb81ea 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1678,7 +1678,7 @@ InfoLibraryCmd( return TCL_ERROR; } - libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY); + libDirName = Tcl_GetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); if (libDirName != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1)); return TCL_OK; @@ -1804,7 +1804,7 @@ InfoPatchLevelCmd( return TCL_ERROR; } - patchlevel = Tcl_GetVar(interp, "tcl_patchLevel", + patchlevel = Tcl_GetVar2(interp, "tcl_patchLevel", NULL, (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); if (patchlevel != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1)); diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index c5b7d28..f61073b 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -197,7 +197,7 @@ TclCreateSocketAddress( */ if (interp != NULL) { - family = Tcl_GetVar(interp, "::tcl::unsupported::socketAF", 0); + family = Tcl_GetVar2(interp, "::tcl::unsupported::socketAF", NULL, 0); if (family != NULL) { if (strcmp(family, "inet") == 0) { hints.ai_family = AF_INET; diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 66ce1e0..c281d6d 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -336,7 +336,7 @@ Tcl_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { if (tclPreInitScript != NULL) { - if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { + if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) { return TCL_ERROR; } } @@ -382,7 +382,7 @@ Tcl_Init( * alternate tclInit command before calling Tcl_Init(). */ - return Tcl_Eval(interp, + return Tcl_EvalEx(interp, "if {[namespace which -command tclInit] eq \"\"} {\n" " proc tclInit {} {\n" " global tcl_libPath tcl_library env tclDefaultLibrary\n" @@ -444,7 +444,7 @@ Tcl_Init( " error $msg\n" " }\n" "}\n" -"tclInit"); +"tclInit", -1, 0); } /* @@ -2368,7 +2368,7 @@ SlaveCreate( SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc); Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS); Tcl_SetHashValue(hPtr, slavePtr); - Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); + Tcl_SetVar2(slaveInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY); /* * Inherit the recursion limit. @@ -3195,8 +3195,8 @@ Tcl_MakeSafe( * Assume these functions all work. [Bug 2895741] */ - (void) Tcl_Eval(interp, - "namespace eval ::tcl {namespace eval mathfunc {}}"); + (void) Tcl_EvalEx(interp, + "namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0); (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master, "::tcl::mathfunc::min", 0, NULL); (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master, diff --git a/generic/tclMain.c b/generic/tclMain.c index 927de7e..de7e29e 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -246,7 +246,7 @@ Tcl_SourceRCFile( const char *fileName; Tcl_Channel chan; - fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); + fileName = Tcl_GetVar2(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_Channel c; const char *fullName; @@ -266,14 +266,16 @@ Tcl_SourceRCFile( c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (c != NULL) { + Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1); Tcl_Close(NULL, c); - if (Tcl_EvalFile(interp, fullName) != TCL_OK) { + if (Tcl_FSEvalFile(interp, fullNameObj) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } + Tcl_DecrRefCount(fullNameObj); } } Tcl_DStringFree(&temp); diff --git a/generic/tclOO.c b/generic/tclOO.c index 0454bfe..9dae778 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -269,7 +269,7 @@ TclOOInit( * to be fully provided. */ - if (Tcl_Eval(interp, initScript) != TCL_OK) { + if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) { return TCL_ERROR; } @@ -463,7 +463,7 @@ InitFoundation( if (TclOODefineSlots(fPtr) != TCL_OK) { return TCL_ERROR; } - return Tcl_Eval(interp, slotScript); + return Tcl_EvalEx(interp, slotScript, -1, 0); } /* diff --git a/generic/tclParse.c b/generic/tclParse.c index 568024b..5577e87 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -1022,7 +1022,7 @@ ParseComment( if (parsePtr->commentStart == NULL) { parsePtr->commentStart = p; } - + p++; numBytes--; while (numBytes) { diff --git a/generic/tclTest.c b/generic/tclTest.c index 7c30d36..8290582 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -1294,7 +1294,7 @@ TestcmdtraceCmd( cmdTrace = Tcl_CreateObjTrace(interp, 50000, TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc, (ClientData) &deleteCalled, ObjTraceDeleteProc); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); Tcl_DeleteTrace(interp, cmdTrace); if (!deleteCalled) { Tcl_SetResult(interp, "Delete wasn't called", TCL_STATIC); @@ -1308,7 +1308,7 @@ TestcmdtraceCmd( Tcl_DStringInit(&buffer); t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer); t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1637,7 +1637,7 @@ DelDeleteProc( { DelCmd *dPtr = clientData; - Tcl_Eval(dPtr->interp, dPtr->deleteCmd); + Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0); Tcl_ResetResult(dPtr->interp); ckfree(dPtr->deleteCmd); ckfree(dPtr); @@ -3972,7 +3972,7 @@ TestregexpObjCmd( varName = Tcl_GetString(objv[2]); TclRegExpRangeUniChar(regExpr, -1, &start, &end); sprintf(resinfo, "%d %d", start, end-1); - value = Tcl_SetVar(interp, varName, resinfo, 0); + value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", NULL); @@ -3986,7 +3986,7 @@ TestregexpObjCmd( Tcl_RegExpGetInfo(regExpr, &info); varName = Tcl_GetString(objv[2]); sprintf(resinfo, "%ld", info.extendStart); - value = Tcl_SetVar(interp, varName, resinfo, 0); + value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", varName, "\"", NULL); @@ -4329,7 +4329,7 @@ StaticInitProc( Tcl_Interp *interp) /* Interpreter in which package is supposedly * being loaded. */ { - Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "x", NULL, "loaded", TCL_GLOBAL_ONLY); return TCL_OK; } @@ -4413,7 +4413,7 @@ TestupvarCmd( } else if (strcmp(argv[4], "namespace") == 0) { flags = TCL_NAMESPACE_ONLY; } - return Tcl_UpVar(interp, argv[1], argv[2], argv[3], flags); + return Tcl_UpVar2(interp, argv[1], argv[2], NULL, argv[3], flags); } else { if (strcmp(argv[5], "global") == 0) { flags = TCL_GLOBAL_ONLY; @@ -4907,10 +4907,10 @@ GetTimesObjCmd( timePer/100000); /* Tcl_SetVar 100000 times */ - fprintf(stderr, "Tcl_SetVar of \"12345\" 100000 times\n"); + fprintf(stderr, "Tcl_SetVar2 of \"12345\" 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { - s = Tcl_SetVar(interp, "a", "12345", TCL_LEAVE_ERR_MSG); + s = Tcl_SetVar2(interp, "a", NULL, "12345", TCL_LEAVE_ERR_MSG); if (s == NULL) { return TCL_ERROR; } @@ -4924,7 +4924,7 @@ GetTimesObjCmd( fprintf(stderr, "Tcl_GetVar of a==\"12345\" 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { - s = Tcl_GetVar(interp, "a", TCL_LEAVE_ERR_MSG); + s = Tcl_GetVar2(interp, "a", NULL, TCL_LEAVE_ERR_MSG); if (s == NULL) { return TCL_ERROR; } @@ -5194,7 +5194,7 @@ TestsaveresultCmd( if (((enum options) index) == RESULT_OBJECT) { result = Tcl_EvalObjEx(interp, objv[2], 0); } else { - result = Tcl_Eval(interp, Tcl_GetString(objv[2])); + result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0); } if (discard) { @@ -6297,7 +6297,7 @@ TestReport( savedResult = Tcl_GetObjResult(interp); Tcl_IncrRefCount(savedResult); Tcl_SetObjResult(interp, Tcl_NewObj()); - Tcl_Eval(interp, Tcl_DStringValue(&ds)); + Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0); Tcl_DStringFree(&ds); Tcl_ResetResult(interp); Tcl_SetObjResult(interp, savedResult); diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 9c66313..1a05f80 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -657,7 +657,7 @@ ThreadErrorProc( sprintf(buf, "%" TCL_LL_MODIFIER "d", (Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); - errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (errorProcString == NULL) { errChannel = Tcl_GetStdChannel(TCL_STDERR); Tcl_WriteChars(errChannel, "Error from thread ", -1); @@ -1032,8 +1032,8 @@ ThreadEventProc( code = Tcl_EvalEx(interp, threadEventPtr->script,-1,TCL_EVAL_GLOBAL); Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script); if (code != TCL_OK) { - errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); - errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); + errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY); + errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); } else { errorCode = errorInfo = NULL; } diff --git a/tests/event.test b/tests/event.test index 207c799..ef0947f 100644 --- a/tests/event.test +++ b/tests/event.test @@ -595,16 +595,16 @@ test event-11.7 {Bug 16828b3744} { test event-11.8 {Bug 16828b3744} -setup { oo::class create A { variable continue - + method start {} { after idle [self] destroy - + set continue 0 vwait [namespace current]::continue } destructor { set continue 1 - } + } } } -body { [A new] start diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 417bedb..5de0101 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -224,7 +224,7 @@ Pkgua_Init( return code; } - Tcl_SetVar(interp, "::pkgua_loaded", ".", TCL_APPEND_VALUE); + Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE); cmdTokens = PkguaInterpToTokens(interp); cmdTokens[cmdIndex++] = @@ -299,7 +299,7 @@ Pkgua_Unload( PkguaDeleteTokens(interp); - Tcl_SetVar(interp, "::pkgua_detached", ".", TCL_APPEND_VALUE); + Tcl_SetVar2(interp, "::pkgua_detached", NULL, ".", TCL_APPEND_VALUE); if (flags == TCL_UNLOAD_DETACH_FROM_PROCESS) { /* @@ -309,7 +309,7 @@ Pkgua_Unload( */ PkguaFreeTokensHashTable(); - Tcl_SetVar(interp, "::pkgua_unloaded", ".", TCL_APPEND_VALUE); + Tcl_SetVar2(interp, "::pkgua_unloaded", NULL, ".", TCL_APPEND_VALUE); } return TCL_OK; } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 5fc0035..71b20e3 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -780,7 +780,7 @@ TclpSetVariables( if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) { Tcl_ResetResult(interp); } - Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "::tcl::mac::locale", NULL, loc, TCL_GLOBAL_ONLY); } } CFRelease(localeRef); @@ -791,9 +791,9 @@ TclpSetVariables( const char *str; CFBundleRef bundleRef; - Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "tcl_pkgPath", " ", + Tcl_SetVar2(interp, "tclDefaultLibrary", NULL, tclLibPath, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ", TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds); @@ -809,9 +809,9 @@ TclpSetVariables( *p = ' '; } } while (*p++); - Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds), + Tcl_SetVar2(interp, "tcl_pkgPath", NULL, Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); - Tcl_SetVar(interp, "tcl_pkgPath", " ", + Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ", TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); Tcl_DStringFree(&ds); } @@ -826,9 +826,9 @@ TclpSetVariables( (unsigned char*) tclLibPath, MAXPATHLEN) && ! TclOSstat(tclLibPath, &statBuf) && S_ISDIR(statBuf.st_mode)) { - Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, + Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); - Tcl_SetVar(interp, "tcl_pkgPath", " ", + Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ", TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); } CFRelease(frameworksURL); @@ -839,20 +839,20 @@ TclpSetVariables( (unsigned char*) tclLibPath, MAXPATHLEN) && ! TclOSstat(tclLibPath, &statBuf) && S_ISDIR(statBuf.st_mode)) { - Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, + Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); - Tcl_SetVar(interp, "tcl_pkgPath", " ", + Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ", TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); } CFRelease(frameworksURL); } } - Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, + Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); } else #endif /* HAVE_COREFOUNDATION */ { - Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY); } #ifdef DJGPP diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 9c5cd4b..8167077 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -735,7 +735,7 @@ TcpHostPortList( #endif /* NEED_FAKE_RFC2553 */ } /* Check if reverse DNS has been switched off globally */ - if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) { + if (interp != NULL && Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { flags |= NI_NUMERICHOST; } if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, flags) == 0) { diff --git a/win/tclWinSock.c b/win/tclWinSock.c index cc77afe..4690708 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1319,7 +1319,7 @@ TcpGetOptionProc( return TCL_OK; } - if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) { + if (interp != NULL && Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) { reverseDNS = NI_NUMERICHOST; } -- cgit v0.12 From 964477ea367a07c99f36ff8dd83af5be6ad23a6e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 29 Jun 2016 15:28:36 +0000 Subject: Eliminate internal use of TCL_STORAGE_CLASS, as it will be gone in 9.0 anyway --- generic/tclTest.c | 12 ++---------- macosx/README | 6 +++--- unix/dltest/pkga.c | 10 +--------- unix/dltest/pkgc.c | 12 ++---------- unix/dltest/pkgd.c | 12 ++---------- unix/dltest/pkge.c | 11 +---------- unix/dltest/pkgua.c | 16 ++++------------ win/tclWinDde.c | 27 +++++++-------------------- 8 files changed, 22 insertions(+), 84 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 8290582..33eaadd 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -42,16 +42,8 @@ * Declare external functions used in Windows tests. */ -/* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Tcltest_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT -EXTERN int Tcltest_Init(Tcl_Interp *interp); -EXTERN int Tcltest_SafeInit(Tcl_Interp *interp); +DLLEXPORT int Tcltest_Init(Tcl_Interp *interp); +DLLEXPORT int Tcltest_SafeInit(Tcl_Interp *interp); /* * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect diff --git a/macosx/README b/macosx/README index bcffde3..551a18e 100644 --- a/macosx/README +++ b/macosx/README @@ -113,7 +113,7 @@ The following build configurations are available: The Xcode projects refer to the toplevel tcl source directory via the TCL_SRCROOT user build setting, by default this is set to the project-relative path '../../tcl', if your tcl source directory is named differently, e.g. -'../../tcl8.6', you need to manually change the TCL_SRCROOT setting by editing +'../../tcl8.7', you need to manually change the TCL_SRCROOT setting by editing your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory) with a text editor. @@ -141,9 +141,9 @@ Detailed Instructions for building with macosx/GNUmakefile - Unpack the Tcl source release archive. - The following instructions assume the Tcl source tree is named "tcl${ver}", -(where ${ver} is a shell variable containing the Tcl version number e.g. '8.6'). +(where ${ver} is a shell variable containing the Tcl version number e.g. '8.7'). Setup this shell variable as follows: - ver="8.6" + ver="8.7" If you are building from CVS, omit this step (CVS source tree names usually do not contain a version number). diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index c4d3f32..2aee1b8 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -14,14 +14,6 @@ #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkga_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -124,7 +116,7 @@ Pkga_QuoteObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkga_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c index 557f21b..48e4d2a 100644 --- a/unix/dltest/pkgc.c +++ b/unix/dltest/pkgc.c @@ -15,14 +15,6 @@ #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkgc_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -114,7 +106,7 @@ Pkgc_UnsafeObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgc_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -151,7 +143,7 @@ Pkgc_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgc_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c index 6e114e9..df7bbc9 100644 --- a/unix/dltest/pkgd.c +++ b/unix/dltest/pkgd.c @@ -15,14 +15,6 @@ #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkgd_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -114,7 +106,7 @@ Pkgd_UnsafeObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgd_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -151,7 +143,7 @@ Pkgd_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgd_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c index 395cd0e..7160d90 100644 --- a/unix/dltest/pkge.c +++ b/unix/dltest/pkge.c @@ -13,15 +13,6 @@ #undef STATIC_BUILD #include "tcl.h" - -/* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkge_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - /* *---------------------------------------------------------------------- @@ -40,7 +31,7 @@ *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkge_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 5de0101..6d95640 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -15,14 +15,6 @@ #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkgua_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -200,7 +192,7 @@ PkguaQuoteObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -253,7 +245,7 @@ Pkgua_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -278,7 +270,7 @@ Pkgua_SafeInit( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_Unload( Tcl_Interp *interp, /* Interpreter from which the package is to be * unloaded. */ @@ -331,7 +323,7 @@ Pkgua_Unload( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_SafeUnload( Tcl_Interp *interp, /* Interpreter from which the package is to be * unloaded. */ diff --git a/win/tclWinDde.c b/win/tclWinDde.c index ce0b413..c852728 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -34,16 +34,6 @@ #endif /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init - * declaration is in the source file itself, which is only accessed when we - * are building a library. DO NOT MOVE BEFORE ANY #include LINES. ONLY USE - * EXTERN TO INDICATE EXPORTED FUNCTIONS FROM NOW ON. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * The following structure is used to keep track of the interpreters * registered by this process. */ @@ -69,13 +59,13 @@ typedef struct Conversation { Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */ } Conversation; -typedef struct DdeEnumServices { +struct DdeEnumServices { Tcl_Interp *interp; int result; ATOM service; ATOM topic; HWND hwnd; -} DdeEnumServices; +}; typedef struct ThreadSpecificData { Conversation *currentConversations; @@ -135,8 +125,8 @@ static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -EXTERN int Dde_Init(Tcl_Interp *interp); -EXTERN int Dde_SafeInit(Tcl_Interp *interp); +DLLEXPORT int Dde_Init(Tcl_Interp *interp); +DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -399,7 +389,7 @@ DdeSetServerName( Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); + Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); @@ -1757,8 +1747,7 @@ DdeObjCmd( objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (objPtr) { - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_AddObjErrorInfo(interp, string, length); + Tcl_AppendObjToErrorInfo(interp, objPtr); } objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, @@ -1853,9 +1842,7 @@ DdeObjCmd( Tcl_DecrRefCount(resultPtr); goto invalidServerResponse; } - length = -1; - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_AddObjErrorInfo(interp, string, length); + Tcl_AppendObjToErrorInfo(interp, objPtr); Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); Tcl_SetObjErrorCode(interp, objPtr); -- cgit v0.12 From c8212c36e91c536433c5a43b8a66ddb19c20d723 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 29 Jun 2016 15:45:26 +0000 Subject: Remove Tcl_Main() function, since it's no longer being used: It has been a macro already for ages. --- generic/tclMain.c | 23 +++++------------------ 1 file changed, 5 insertions(+), 18 deletions(-) diff --git a/generic/tclMain.c b/generic/tclMain.c index de7e29e..28f8fd8 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -112,7 +112,7 @@ typedef enum { PROMPT_CONTINUE /* Print prompt for command continuation */ } PromptType; -typedef struct InteractiveState { +typedef struct { Tcl_Channel input; /* The standard input channel from which lines * are read. */ int tty; /* Non-zero means standard input is a @@ -267,8 +267,10 @@ Tcl_SourceRCFile( c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (c != NULL) { Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1); + Tcl_Close(NULL, c); - if (Tcl_FSEvalFile(interp, fullNameObj) != TCL_OK) { + Tcl_IncrRefCount(fullNameObj); + if (Tcl_FSEvalFileEx(interp, fullNameObj, NULL) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); @@ -285,7 +287,7 @@ Tcl_SourceRCFile( /*---------------------------------------------------------------------- * - * Tcl_Main, Tcl_MainEx -- + * Tcl_MainEx -- * * Main program for tclsh and most other Tcl-based applications. * @@ -636,21 +638,6 @@ Tcl_MainEx( Tcl_Exit(exitCode); } - -#if (TCL_MAJOR_VERSION == 8) && !defined(UNICODE) -#undef Tcl_Main -extern DLLEXPORT void -Tcl_Main( - int argc, /* Number of arguments. */ - char **argv, /* Array of argument strings. */ - Tcl_AppInitProc *appInitProc) - /* Application-specific initialization - * function to call after most initialization - * but before starting to execute commands. */ -{ - Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp()); -} -#endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */ #ifndef TCL_ASCII_MAIN -- cgit v0.12