summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclEnsemble.c22
-rw-r--r--generic/tclExecute.c7
-rw-r--r--generic/tclInterp.c32
-rw-r--r--generic/tclOO.c16
-rw-r--r--generic/tclOODefineCmds.c58
-rw-r--r--generic/tclOOMethod.c27
-rw-r--r--generic/tclProc.c17
-rw-r--r--tests/namespace.test16
9 files changed, 64 insertions, 137 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 505f6c2..25f7e78 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -724,9 +724,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.
@@ -4221,7 +4219,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..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,25 +1875,10 @@ NsEnsembleImplementationCmdNR(
* count both as inserted and removed arguments.
*/
- if (iPtr->ensembleRewrite.sourceObjs == NULL) {
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs =
- 2 + ensemblePtr->numParameters;
- iPtr->ensembleRewrite.numInsertedObjs =
- prefixObjc + ensemblePtr->numParameters;
+ if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters,
+ prefixObjc + ensemblePtr->numParameters, objv)) {
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) {
- iPtr->ensembleRewrite.numRemovedObjs += ni;
- iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
- } else {
- iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
- }
}
/*
@@ -2013,7 +1997,7 @@ TclInitRewriteEnsemble(
if (numIns < numRemoved) {
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 3f57333..0a6e60e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2074,6 +2074,8 @@ TclNRExecuteByteCode(
* Push the callback for bytecode execution
*/
+ TclResetRewriteEnsemble(interp, 1);
+
TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
/* cleanup */ INT2PTR(0), NULL);
return TCL_OK;
@@ -3172,9 +3174,8 @@ 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;
+
+ TclInitRewriteEnsemble(interp, opnd, 1, objv);
DECACHE_STACK_INFO();
pc += 6;
TEBC_YIELD();
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/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);
}
/*
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index c880754..8747ff5 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -847,9 +847,8 @@ TclOODefineObjCmd(
TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
- Interp *iPtr = (Interp *) interp;
Tcl_Command cmd;
- int dummy;
+ int isRoot, dummy;
/*
* More than one argument: fire them through the ensemble processing
@@ -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;
- }
- }
+ isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
/*
* Build the list of arguments using a Tcl_Obj as a workspace. See
@@ -894,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);
@@ -927,7 +918,7 @@ TclOOObjDefObjCmd(
Tcl_Obj *const *objv)
{
Foundation *fPtr = TclOOGetFoundation(interp);
- int result;
+ int isRoot, result;
Object *oPtr;
if (objc < 3) {
@@ -962,7 +953,6 @@ TclOOObjDefObjCmd(
TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
- Interp *iPtr = (Interp *) interp;
Tcl_Command cmd;
int dummy;
@@ -976,18 +966,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;
- }
- }
+ isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
/*
* Build the list of arguments using a Tcl_Obj as a workspace. See
@@ -1009,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);
@@ -1077,9 +1060,8 @@ TclOODefineSelfObjCmd(
TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
- Interp *iPtr = (Interp *) interp;
Tcl_Command cmd;
- int dummy;
+ int isRoot, dummy;
/*
* More than one argument: fire them through the ensemble processing
@@ -1091,18 +1073,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;
- }
- }
+ isRoot = TclInitRewriteEnsemble(interp, 2, 1, objv);
/*
* Build the list of arguments using a Tcl_Obj as a workspace. See
@@ -1124,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);
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 34fa108..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);
@@ -1594,12 +1599,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));
@@ -1613,22 +1615,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 e8c5955..b663caf 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -22,7 +22,6 @@
*/
typedef struct {
- int isRootEnsemble;
Command cmd;
ExtraFrameInfo efi;
} ApplyExtraData;
@@ -2634,7 +2633,7 @@ TclNRApplyObjCmd(
Interp *iPtr = (Interp *) interp;
Proc *procPtr = NULL;
Tcl_Obj *lambdaPtr, *nsObjPtr;
- int result, isRootEnsemble;
+ int result;
Tcl_Namespace *nsPtr;
ApplyExtraData *extraPtr;
@@ -2717,15 +2716,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) {
@@ -2743,10 +2736,6 @@ ApplyNR2(
{
ApplyExtraData *extraPtr = data[0];
- if (extraPtr->isRootEnsemble) {
- ((Interp *) interp)->ensembleRewrite.sourceObjs = NULL;
- }
-
TclStackFree(interp, extraPtr);
return result;
}
diff --git a/tests/namespace.test b/tests/namespace.test
index 5c5783b..fc74d73 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 {
generated by cgit v0.12 at 2024-12-27 13:34:56 (GMT)