summaryrefslogtreecommitdiffstats
path: root/generic/tclInterp.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclInterp.c')
-rw-r--r--generic/tclInterp.c586
1 files changed, 209 insertions, 377 deletions
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index a156a57..dbbf10a 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -19,7 +19,7 @@
* above. This variable can be modified by the function below.
*/
-static const char *tclPreInitScript = NULL;
+static char *tclPreInitScript = NULL;
/* Forward declaration */
struct Target;
@@ -179,6 +179,37 @@ typedef struct ScriptLimitCallbackKey {
} ScriptLimitCallbackKey;
/*
+ * TIP#143 limit handler internal representation.
+ */
+
+struct LimitHandler {
+ int flags; /* The state of this particular handler. */
+ Tcl_LimitHandlerProc *handlerProc;
+ /* The handler callback. */
+ ClientData clientData; /* Opaque argument to the handler callback. */
+ Tcl_LimitHandlerDeleteProc *deleteProc;
+ /* How to delete the clientData. */
+ LimitHandler *prevPtr; /* Previous item in linked list of
+ * handlers. */
+ LimitHandler *nextPtr; /* Next item in linked list of handlers. */
+};
+
+/*
+ * Values for the LimitHandler flags field.
+ * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
+ * processed; handlers are never to be entered reentrantly.
+ * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
+ * should not normally be observed because when a handler is
+ * deleted it is also spliced out of the list of handlers, but
+ * even so we will be careful.
+ */
+
+#define LIMIT_HANDLER_ACTIVE 0x01
+#define LIMIT_HANDLER_DELETED 0x02
+
+
+
+/*
* Prototypes for local static functions:
*/
@@ -194,9 +225,6 @@ static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
static int AliasObjCmd(ClientData dummy,
Tcl_Interp *currentInterp, int objc,
Tcl_Obj *const objv[]);
-static int AliasNRCmd(ClientData dummy,
- Tcl_Interp *currentInterp, int objc,
- Tcl_Obj *const objv[]);
static void AliasObjCmdDeleteProc(ClientData clientData);
static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static Tcl_Interp * GetInterp2(Tcl_Interp *interp, int objc,
@@ -266,11 +294,11 @@ static void TimeLimitCallback(ClientData clientData);
*----------------------------------------------------------------------
*/
-const char *
+char *
TclSetPreInitScript(
- const char *string) /* Pointer to a script. */
+ char *string) /* Pointer to a script. */
{
- const char *prevString = tclPreInitScript;
+ char *prevString = tclPreInitScript;
tclPreInitScript = string;
return(prevString);
}
@@ -300,8 +328,8 @@ Tcl_Init(
{
if (tclPreInitScript != NULL) {
if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
- return TCL_ERROR;
- }
+ return (TCL_ERROR);
+ };
}
/*
@@ -436,7 +464,7 @@ TclInterpInit(
Master *masterPtr;
Slave *slavePtr;
- interpInfoPtr = ckalloc(sizeof(InterpInfo));
+ interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));
((Interp *) interp)->interpInfo = interpInfoPtr;
masterPtr = &interpInfoPtr->master;
@@ -532,7 +560,7 @@ InterpInfoDeleteProc(
}
Tcl_DeleteHashTable(&slavePtr->aliasTable);
- ckfree(interpInfoPtr);
+ ckfree((char *) interpInfoPtr);
}
/*
@@ -559,24 +587,21 @@ Tcl_InterpObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Interp *slaveInterp;
int index;
- static const char *const options[] = {
- "alias", "aliases", "bgerror", "cancel",
- "create", "debug", "delete",
- "eval", "exists", "expose",
- "hide", "hidden", "issafe",
- "invokehidden", "limit", "marktrusted", "recursionlimit",
- "slaves", "share", "target", "transfer",
+ static const char *options[] = {
+ "alias", "aliases", "bgerror", "create",
+ "debug", "delete", "eval", "exists", "expose",
+ "hide", "hidden", "issafe", "invokehidden",
+ "limit", "marktrusted", "recursionlimit","slaves",
+ "share", "target", "transfer",
NULL
};
enum option {
- OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CANCEL,
- OPT_CREATE, OPT_DEBUG, OPT_DELETE,
- OPT_EVAL, OPT_EXISTS, OPT_EXPOSE,
- OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE,
- OPT_INVOKEHID, OPT_LIMIT, OPT_MARKTRUSTED,OPT_RECLIMIT,
- OPT_SLAVES, OPT_SHARE, OPT_TARGET, OPT_TRANSFER
+ OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CREATE,
+ OPT_DEBUG, OPT_DELETE, OPT_EVAL, OPT_EXISTS, OPT_EXPOSE,
+ OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID,
+ OPT_LIMIT, OPT_MARKTRUSTED,OPT_RECLIMIT, OPT_SLAVES,
+ OPT_SHARE, OPT_TARGET, OPT_TRANSFER
};
if (objc < 2) {
@@ -589,12 +614,12 @@ Tcl_InterpObjCmd(
}
switch ((enum option) index) {
case OPT_ALIAS: {
- Tcl_Interp *masterInterp;
+ Tcl_Interp *slaveInterp, *masterInterp;
if (objc < 4) {
aliasArgs:
Tcl_WrongNumArgs(interp, 2, objv,
- "slavePath slaveCmd ?masterPath masterCmd? ?arg ...?");
+ "slavePath slaveCmd ?masterPath masterCmd? ?args ..?");
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, objv[2]);
@@ -623,13 +648,18 @@ Tcl_InterpObjCmd(
}
goto aliasArgs;
}
- case OPT_ALIASES:
+ case OPT_ALIASES: {
+ Tcl_Interp *slaveInterp;
+
slaveInterp = GetInterp2(interp, objc, objv);
if (slaveInterp == NULL) {
return TCL_ERROR;
}
return AliasList(interp, slaveInterp);
- case OPT_BGERROR:
+ }
+ case OPT_BGERROR: {
+ Tcl_Interp *slaveInterp;
+
if (objc != 3 && objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path ?cmdPrefix?");
return TCL_ERROR;
@@ -639,83 +669,12 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveBgerror(interp, slaveInterp, objc - 3, objv + 3);
- case OPT_CANCEL: {
- int i, flags;
- Tcl_Obj *resultObjPtr;
- static const char *const cancelOptions[] = {
- "-unwind", "--", NULL
- };
- enum option {
- OPT_UNWIND, OPT_LAST
- };
-
- flags = 0;
-
- for (i = 2; i < objc; i++) {
- if (TclGetString(objv[i])[0] != '-') {
- break;
- }
- if (Tcl_GetIndexFromObj(interp, objv[i], cancelOptions, "option",
- 0, &index) != TCL_OK) {
- return TCL_ERROR;
- }
-
- switch ((enum option) index) {
- case OPT_UNWIND:
- /*
- * The evaluation stack in the target interp is to be unwound.
- */
-
- flags |= TCL_CANCEL_UNWIND;
- break;
- case OPT_LAST:
- i++;
- goto endOfForLoop;
- }
- }
-
- endOfForLoop:
- if ((i + 2) < objc) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "?-unwind? ?--? ?path? ?result?");
- return TCL_ERROR;
- }
-
- /*
- * Did they specify a slave interp to cancel the script in progress
- * in? If not, use the current interp.
- */
-
- if (i < objc) {
- slaveInterp = GetInterp(interp, objv[i]);
- if (slaveInterp == NULL) {
- return TCL_ERROR;
- }
- i++;
- } else {
- slaveInterp = interp;
- }
-
- if (i < objc) {
- resultObjPtr = objv[i];
-
- /*
- * Tcl_CancelEval removes this reference.
- */
-
- Tcl_IncrRefCount(resultObjPtr);
- i++;
- } else {
- resultObjPtr = NULL;
- }
-
- return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags);
}
case OPT_CREATE: {
int i, last, safe;
Tcl_Obj *slavePtr;
char buf[16 + TCL_INTEGER_SPACE];
- static const char *const createOptions[] = {
+ static const char *options[] = {
"-safe", "--", NULL
};
enum option {
@@ -732,8 +691,8 @@ Tcl_InterpObjCmd(
last = 0;
for (i = 2; i < objc; i++) {
if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {
- if (Tcl_GetIndexFromObj(interp, objv[i], createOptions,
- "option", 0, &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
if (index == OPT_SAFE) {
@@ -779,11 +738,13 @@ Tcl_InterpObjCmd(
Tcl_SetObjResult(interp, slavePtr);
return TCL_OK;
}
- case OPT_DEBUG: /* TIP #378 */
+ case OPT_DEBUG: {
+ /* TIP #378 */
+ Tcl_Interp *slaveInterp;
+
/*
* Currently only -frame supported, otherwise ?-option ?value??
*/
-
if (objc < 3 || objc > 5) {
Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??");
return TCL_ERROR;
@@ -793,9 +754,11 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3);
+ }
case OPT_DELETE: {
int i;
InterpInfo *iiPtr;
+ Tcl_Interp *slaveInterp;
for (i = 2; i < objc; i++) {
slaveInterp = GetInterp(interp, objv[i]);
@@ -804,8 +767,6 @@ Tcl_InterpObjCmd(
} else if (slaveInterp == interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot delete the current interpreter", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "DELETESELF", NULL);
return TCL_ERROR;
}
iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
@@ -814,7 +775,9 @@ Tcl_InterpObjCmd(
}
return TCL_OK;
}
- case OPT_EVAL:
+ case OPT_EVAL: {
+ Tcl_Interp *slaveInterp;
+
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
return TCL_ERROR;
@@ -824,9 +787,12 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
+ }
case OPT_EXISTS: {
- int exists = 1;
+ int exists;
+ Tcl_Interp *slaveInterp;
+ exists = 1;
slaveInterp = GetInterp2(interp, objc, objv);
if (slaveInterp == NULL) {
if (objc > 3) {
@@ -838,7 +804,9 @@ Tcl_InterpObjCmd(
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
return TCL_OK;
}
- case OPT_EXPOSE:
+ case OPT_EXPOSE: {
+ Tcl_Interp *slaveInterp;
+
if ((objc < 4) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "path hiddenCmdName ?cmdName?");
return TCL_ERROR;
@@ -848,7 +816,10 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
- case OPT_HIDE:
+ }
+ case OPT_HIDE: {
+ Tcl_Interp *slaveInterp; /* A slave. */
+
if ((objc < 4) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "path cmdName ?hiddenCmdName?");
return TCL_ERROR;
@@ -858,23 +829,31 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);
- case OPT_HIDDEN:
+ }
+ case OPT_HIDDEN: {
+ Tcl_Interp *slaveInterp; /* A slave. */
+
slaveInterp = GetInterp2(interp, objc, objv);
if (slaveInterp == NULL) {
return TCL_ERROR;
}
return SlaveHidden(interp, slaveInterp);
- case OPT_ISSAFE:
+ }
+ case OPT_ISSAFE: {
+ Tcl_Interp *slaveInterp;
+
slaveInterp = GetInterp2(interp, objc, objv);
if (slaveInterp == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
return TCL_OK;
+ }
case OPT_INVOKEHID: {
- int i;
+ int i, index;
const char *namespaceName;
- static const char *const hiddenOptions[] = {
+ Tcl_Interp *slaveInterp;
+ static const char *hiddenOptions[] = {
"-global", "-namespace", "--", NULL
};
enum hiddenOption {
@@ -916,7 +895,8 @@ Tcl_InterpObjCmd(
objv + i);
}
case OPT_LIMIT: {
- static const char *const limitTypes[] = {
+ Tcl_Interp *slaveInterp;
+ static const char *limitTypes[] = {
"commands", "time", NULL
};
enum LimitTypes {
@@ -925,8 +905,7 @@ Tcl_InterpObjCmd(
int limitType;
if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "path limitType ?-option value ...?");
+ Tcl_WrongNumArgs(interp, 2, objv, "path limitType ?options?");
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, objv[2]);
@@ -944,7 +923,9 @@ Tcl_InterpObjCmd(
return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv);
}
}
- case OPT_MARKTRUSTED:
+ case OPT_MARKTRUSTED: {
+ Tcl_Interp *slaveInterp;
+
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "path");
return TCL_ERROR;
@@ -954,7 +935,10 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveMarkTrusted(interp, slaveInterp);
- case OPT_RECLIMIT:
+ }
+ case OPT_RECLIMIT: {
+ Tcl_Interp *slaveInterp;
+
if (objc != 3 && objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?");
return TCL_ERROR;
@@ -964,7 +948,9 @@ Tcl_InterpObjCmd(
return TCL_ERROR;
}
return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);
+ }
case OPT_SLAVES: {
+ Tcl_Interp *slaveInterp;
InterpInfo *iiPtr;
Tcl_Obj *resultPtr;
Tcl_HashEntry *hPtr;
@@ -988,7 +974,8 @@ Tcl_InterpObjCmd(
}
case OPT_TRANSFER:
case OPT_SHARE: {
- Tcl_Interp *masterInterp; /* The master of the slave. */
+ Tcl_Interp *slaveInterp; /* A slave. */
+ Tcl_Interp *masterInterp; /* Its master. */
Tcl_Channel chan;
if (objc != 5) {
@@ -1001,7 +988,7 @@ Tcl_InterpObjCmd(
}
chan = Tcl_GetChannel(masterInterp, TclGetString(objv[3]), NULL);
if (chan == NULL) {
- Tcl_TransferResult(masterInterp, TCL_OK, interp);
+ TclTransferResult(masterInterp, TCL_OK, interp);
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, objv[4]);
@@ -1016,17 +1003,18 @@ Tcl_InterpObjCmd(
*/
if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
- Tcl_TransferResult(masterInterp, TCL_OK, interp);
+ TclTransferResult(masterInterp, TCL_OK, interp);
return TCL_ERROR;
}
}
return TCL_OK;
}
case OPT_TARGET: {
+ Tcl_Interp *slaveInterp;
InterpInfo *iiPtr;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
- const char *aliasName;
+ char *aliasName;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path alias");
@@ -1055,8 +1043,6 @@ Tcl_InterpObjCmd(
Tcl_AppendResult(interp, "target interpreter for alias \"",
aliasName, "\" in path \"", Tcl_GetString(objv[2]),
"\" is not my descendant", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "TARGETSHROUDED", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1133,7 +1119,8 @@ Tcl_CreateAlias(
int i;
int result;
- objv = TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
+ objv = (Tcl_Obj **)
+ TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
for (i = 0; i < argc; i++) {
objv[i] = Tcl_NewStringObj(argv[i], -1);
Tcl_IncrRefCount(objv[i]);
@@ -1253,7 +1240,7 @@ Tcl_GetAlias(
}
if (argvPtr != NULL) {
*argvPtr = (const char **)
- ckalloc(sizeof(const char *) * (objc - 1));
+ ckalloc((unsigned) sizeof(const char *) * (objc - 1));
for (i = 1; i < objc; i++) {
(*argvPtr)[i - 1] = TclGetString(objv[i]);
}
@@ -1367,7 +1354,7 @@ TclPreventAliasLoop(
* chain then we have a loop.
*/
- aliasPtr = cmdPtr->objClientData;
+ aliasPtr = (Alias *) cmdPtr->objClientData;
nextAliasPtr = aliasPtr;
while (1) {
Tcl_Obj *cmdNamePtr;
@@ -1401,8 +1388,6 @@ TclPreventAliasLoop(
Tcl_AppendResult(interp, "cannot define or rename alias \"",
Tcl_GetCommandName(cmdInterp, cmd),
"\": would create a loop", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "ALIASLOOP", NULL);
return TCL_ERROR;
}
@@ -1415,7 +1400,7 @@ TclPreventAliasLoop(
if (aliasCmdPtr->objProc != AliasObjCmd) {
return TCL_OK;
}
- nextAliasPtr = aliasCmdPtr->objClientData;
+ nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
}
/* NOTREACHED */
@@ -1458,7 +1443,8 @@ AliasCreate(
Tcl_Obj **prefv;
int isNew, i;
- aliasPtr = ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
+ aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias)
+ + objc * sizeof(Tcl_Obj *)));
aliasPtr->token = namePtr;
Tcl_IncrRefCount(aliasPtr->token);
aliasPtr->targetInterp = masterInterp;
@@ -1476,15 +1462,9 @@ AliasCreate(
Tcl_Preserve(slaveInterp);
Tcl_Preserve(masterInterp);
- if (slaveInterp == masterInterp) {
- aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
- TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr,
- AliasObjCmdDeleteProc);
- } else {
aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
TclGetString(namePtr), AliasObjCmd, aliasPtr,
AliasObjCmdDeleteProc);
- }
if (TclPreventAliasLoop(interp, slaveInterp,
aliasPtr->slaveCmd) != TCL_OK) {
@@ -1509,7 +1489,7 @@ AliasCreate(
cmdPtr->deleteData = NULL;
Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
- ckfree(aliasPtr);
+ ckfree((char *) aliasPtr);
/*
* The result was already set by TclPreventAliasLoop.
@@ -1527,7 +1507,7 @@ AliasCreate(
slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
while (1) {
Tcl_Obj *newToken;
- const char *string;
+ char *string;
string = TclGetString(aliasPtr->token);
hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &isNew);
@@ -1566,11 +1546,11 @@ AliasCreate(
* interp alias {} foo {} zop # Now recreate "foo"...
*/
- targetPtr = ckalloc(sizeof(Target));
+ targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
targetPtr->slaveCmd = aliasPtr->slaveCmd;
targetPtr->slaveInterp = slaveInterp;
- masterPtr = &((InterpInfo*) ((Interp*) masterInterp)->interpInfo)->master;
+ masterPtr = &((InterpInfo *) ((Interp*) masterInterp)->interpInfo)->master;
targetPtr->nextPtr = masterPtr->targetsPtr;
targetPtr->prevPtr = NULL;
if (masterPtr->targetsPtr != NULL) {
@@ -1739,70 +1719,6 @@ AliasList(
*/
static int
-AliasNRCmd(
- ClientData clientData, /* Alias record. */
- Tcl_Interp *interp, /* Current interpreter. */
- 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;
-
- /*
- * Append the arguments to the command prefix and invoke the command in
- * the target interp's global namespace.
- */
-
- prefc = aliasPtr->objc;
- prefv = &aliasPtr->objPtr;
- cmdc = prefc + objc - 1;
-
- listPtr = Tcl_NewListObj(cmdc, NULL);
- listRep = listPtr->internalRep.twoPtrValue.ptr1;
- listRep->elemCount = cmdc;
- cmdv = &listRep->elements;
-
- prefv = &aliasPtr->objPtr;
- memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
- memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
-
- for (i=0; i<cmdc; i++) {
- Tcl_IncrRefCount(cmdv[i]);
- }
-
- /*
- * Use the ensemble rewriting machinery to ensure correct error messages:
- * 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) {
- TclNRDeferCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
- }
- iPtr->evalFlags |= TCL_EVAL_REDIRECT;
- return Tcl_NREvalObj(interp, listPtr, flags);
-}
-
-static int
AliasObjCmd(
ClientData clientData, /* Alias record. */
Tcl_Interp *interp, /* Current interpreter. */
@@ -1829,10 +1745,9 @@ AliasObjCmd(
if (cmdc <= ALIAS_CMDV_PREALLOC) {
cmdv = cmdArr;
} else {
- cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
+ cmdv = (Tcl_Obj **) TclStackAlloc(interp, cmdc*(int)sizeof(Tcl_Obj*));
}
- prefv = &aliasPtr->objPtr;
memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
@@ -1888,7 +1803,7 @@ AliasObjCmd(
*/
if (targetInterp != interp) {
- Tcl_TransferResult(targetInterp, result, interp);
+ TclTransferResult(targetInterp, result, interp);
Tcl_Release(targetInterp);
}
@@ -1953,8 +1868,8 @@ AliasObjCmdDeleteProc(
targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
}
- ckfree(targetPtr);
- ckfree(aliasPtr);
+ ckfree((char *) targetPtr);
+ ckfree((char *) aliasPtr);
}
/*
@@ -2059,72 +1974,6 @@ Tcl_GetMaster(
/*
*----------------------------------------------------------------------
*
- * TclSetSlaveCancelFlags --
- *
- * This function marks all slave interpreters belonging to a given
- * interpreter as being canceled or not canceled, depending on the
- * provided flags.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSetSlaveCancelFlags(
- Tcl_Interp *interp, /* Set cancel flags of this interpreter. */
- int flags, /* Collection of OR-ed bits that control
- * the cancellation of the script. Only
- * TCL_CANCEL_UNWIND is currently
- * supported. */
- int force) /* Non-zero to ignore numLevels for the purpose
- * of resetting the cancellation flags. */
-{
- Master *masterPtr; /* Master record of given interpreter. */
- Tcl_HashEntry *hPtr; /* Search element. */
- Tcl_HashSearch hashSearch; /* Search variable. */
- Slave *slavePtr; /* Slave record of interpreter. */
- Interp *iPtr;
-
- if (interp == NULL) {
- return;
- }
-
- flags &= (CANCELED | TCL_CANCEL_UNWIND);
-
- masterPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->master;
-
- hPtr = Tcl_FirstHashEntry(&masterPtr->slaveTable, &hashSearch);
- for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
- slavePtr = Tcl_GetHashValue(hPtr);
- iPtr = (Interp *) slavePtr->slaveInterp;
-
- if (iPtr == NULL) {
- continue;
- }
-
- if (flags == 0) {
- TclResetCancellation((Tcl_Interp *) iPtr, force);
- } else {
- TclSetCancelFlags(iPtr, flags);
- }
-
- /*
- * Now, recursively handle this for the slaves of this slave
- * interpreter.
- */
-
- TclSetSlaveCancelFlags((Tcl_Interp *) iPtr, flags, force);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_GetInterpPath --
*
* Sets the result of the asking interpreter to a proper Tcl list
@@ -2258,8 +2107,6 @@ SlaveBgerror(
|| (length < 1)) {
Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1",
NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "BGERRORFORMAT", NULL);
return TCL_ERROR;
}
TclSetBgErrorHandler(slaveInterp, objv[0]);
@@ -2297,7 +2144,7 @@ SlaveCreate(
Slave *slavePtr;
InterpInfo *masterInfoPtr;
Tcl_HashEntry *hPtr;
- const char *path;
+ char *path;
int isNew, objc;
Tcl_Obj **objv;
@@ -2395,7 +2242,7 @@ SlaveCreate(
return slaveInterp;
error:
- Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
+ TclTransferResult(slaveInterp, TCL_ERROR, interp);
error2:
Tcl_DeleteInterp(slaveInterp);
@@ -2428,17 +2275,15 @@ SlaveObjCmd(
{
Tcl_Interp *slaveInterp = clientData;
int index;
- static const char *const options[] = {
- "alias", "aliases", "bgerror", "debug",
- "eval", "expose", "hide", "hidden",
- "issafe", "invokehidden", "limit", "marktrusted",
- "recursionlimit", NULL
+ static const char *options[] = {
+ "alias", "aliases", "bgerror", "debug", "eval",
+ "expose", "hide", "hidden", "issafe",
+ "invokehidden", "limit", "marktrusted", "recursionlimit", NULL
};
enum options {
- OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_DEBUG,
- OPT_EVAL, OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN,
- OPT_ISSAFE, OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED,
- OPT_RECLIMIT
+ OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_DEBUG, OPT_EVAL,
+ OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE,
+ OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT
};
if (slaveInterp == NULL) {
@@ -2469,7 +2314,7 @@ SlaveObjCmd(
objv[3], objc - 4, objv + 4);
}
}
- Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?arg ...?");
+ Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?args..?");
return TCL_ERROR;
case OPT_ALIASES:
if (objc != 2) {
@@ -2485,7 +2330,7 @@ SlaveObjCmd(
return SlaveBgerror(interp, slaveInterp, objc - 2, objv + 2);
case OPT_DEBUG:
/*
- * TIP #378
+ * TIP #378 *
* Currently only -frame supported, otherwise ?-option ?value? ...?
*/
if (objc > 4) {
@@ -2525,9 +2370,9 @@ SlaveObjCmd(
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
return TCL_OK;
case OPT_INVOKEHIDDEN: {
- int i;
+ int i, index;
const char *namespaceName;
- static const char *const hiddenOptions[] = {
+ static const char *hiddenOptions[] = {
"-global", "-namespace", "--", NULL
};
enum hiddenOption {
@@ -2565,7 +2410,7 @@ SlaveObjCmd(
objc - i, objv + i);
}
case OPT_LIMIT: {
- static const char *const limitTypes[] = {
+ static const char *limitTypes[] = {
"commands", "time", NULL
};
enum LimitTypes {
@@ -2574,7 +2419,7 @@ SlaveObjCmd(
int limitType;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "limitType ?-option value ...?");
+ Tcl_WrongNumArgs(interp, 2, objv, "limitType ?options?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[2], limitTypes, "limit type", 0,
@@ -2664,7 +2509,7 @@ SlaveObjCmdDeleteProc(
* A standard Tcl result.
*
* Side effects:
- * May modify INTERP_DEBUG_FRAME flag in the slave.
+ * May modify INTERP_DEBUG flag in the slave.
*
*----------------------------------------------------------------------
*/
@@ -2677,7 +2522,7 @@ SlaveDebugCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static const char *const debugTypes[] = {
+ static const char *debugTypes[] = {
"-frame", NULL
};
enum DebugTypes {
@@ -2696,8 +2541,8 @@ SlaveDebugCmd(
Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
Tcl_SetObjResult(interp, resultPtr);
} else {
- if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, "debug option",
- 0, &debugType) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes,
+ "debug option", 0, &debugType) != TCL_OK) {
return TCL_ERROR;
}
if (debugType == DEBUG_TYPE_FRAME) {
@@ -2706,13 +2551,11 @@ SlaveDebugCmd(
!= TCL_OK) {
return TCL_ERROR;
}
-
/*
- * Quietly ignore attempts to disable interp debugging. This
- * is a one-way switch as frame debug info is maintained in a
- * stack that must be consistent once turned on.
+ * Quietly ignore attempts to disable interp debugging.
+ * This is a one-way switch as frame debug info is maintained
+ * in a stack that must be consistent once turned on.
*/
-
if (debugType) {
iPtr->flags |= INTERP_DEBUG_FRAME;
}
@@ -2749,16 +2592,7 @@ SlaveEval(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
-
- /*
- * TIP #285: If necessary, reset the cancellation flags for the slave
- * interpreter now; otherwise, canceling a script in a master interpreter
- * can result in a situation where a slave interpreter can no longer
- * evaluate any scripts unless somebody calls the TclResetCancellation
- * function for that particular Tcl_Interp.
- */
-
- TclSetSlaveCancelFlags(slaveInterp, 0, 0);
+ Tcl_Obj *objPtr;
Tcl_Preserve(slaveInterp);
Tcl_AllowExceptions(slaveInterp);
@@ -2768,20 +2602,19 @@ SlaveEval(
* TIP #280: Make actual argument location available to eval'd script.
*/
- Interp *iPtr = (Interp *) interp;
- CmdFrame *invoker = iPtr->cmdFramePtr;
- int word = 0;
-
- TclArgumentGet(interp, objv[0], &invoker, &word);
+ Interp *iPtr = (Interp *) interp;
+ CmdFrame* invoker = iPtr->cmdFramePtr;
+ int word = 0;
+ TclArgumentGet (interp, objv[0], &invoker, &word);
result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
} else {
- Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv);
+ objPtr = Tcl_ConcatObj(objc, objv);
Tcl_IncrRefCount(objPtr);
result = Tcl_EvalObjEx(slaveInterp, objPtr, 0);
Tcl_DecrRefCount(objPtr);
}
- Tcl_TransferResult(slaveInterp, result, interp);
+ TclTransferResult(slaveInterp, result, interp);
Tcl_Release(slaveInterp);
return result;
@@ -2811,21 +2644,19 @@ SlaveExpose(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
- const char *name;
+ char *name;
if (Tcl_IsSafe(interp)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"permission denied: safe interpreter cannot expose commands",
-1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
- NULL);
return TCL_ERROR;
}
name = TclGetString(objv[(objc == 1) ? 0 : 1]);
if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]),
name) != TCL_OK) {
- Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
+ TclTransferResult(slaveInterp, TCL_ERROR, interp);
return TCL_ERROR;
}
return TCL_OK;
@@ -2862,8 +2693,6 @@ SlaveRecursionLimit(
if (Tcl_IsSafe(interp)) {
Tcl_AppendResult(interp, "permission denied: "
"safe interpreters cannot change recursion limit", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
- NULL);
return TCL_ERROR;
}
if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
@@ -2872,8 +2701,6 @@ SlaveRecursionLimit(
if (limit <= 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"recursion limit must be > 0", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT",
- NULL);
return TCL_ERROR;
}
Tcl_SetRecursionLimit(slaveInterp, limit);
@@ -2881,7 +2708,6 @@ SlaveRecursionLimit(
if (interp == slaveInterp && iPtr->numLevels > limit) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"falling back due to new recursion limit", -1));
- Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, objv[0]);
@@ -2917,20 +2743,18 @@ SlaveHide(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
- const char *name;
+ char *name;
if (Tcl_IsSafe(interp)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"permission denied: safe interpreter cannot hide commands",
-1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
- NULL);
return TCL_ERROR;
}
name = TclGetString(objv[(objc == 1) ? 0 : 1]);
if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) {
- Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
+ TclTransferResult(slaveInterp, TCL_ERROR, interp);
return TCL_ERROR;
}
return TCL_OK;
@@ -3007,8 +2831,6 @@ SlaveInvokeHidden(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"not allowed to invoke hidden commands from safe interpreter",
-1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
- NULL);
return TCL_ERROR;
}
@@ -3026,11 +2848,11 @@ SlaveInvokeHidden(
| TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if (result == TCL_OK) {
result = TclObjInvokeNamespace(slaveInterp, objc, objv,
- (Tcl_Namespace *) nsPtr, TCL_INVOKE_HIDDEN);
+ (Tcl_Namespace *)nsPtr, TCL_INVOKE_HIDDEN);
}
}
- Tcl_TransferResult(slaveInterp, result, interp);
+ TclTransferResult(slaveInterp, result, interp);
Tcl_Release(slaveInterp);
return result;
@@ -3063,8 +2885,6 @@ SlaveMarkTrusted(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"permission denied: safe interpreter cannot mark trusted",
-1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
- NULL);
return TCL_ERROR;
}
((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;
@@ -3322,7 +3142,6 @@ Tcl_LimitCheck(
} else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "command count limit exceeded", NULL);
- Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL);
Tcl_Release(interp);
return TCL_ERROR;
}
@@ -3348,7 +3167,6 @@ Tcl_LimitCheck(
} else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "time limit exceeded", NULL);
- Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL);
Tcl_Release(interp);
return TCL_ERROR;
}
@@ -3401,7 +3219,7 @@ RunLimitHandlers(
*/
handlerPtr->flags |= LIMIT_HANDLER_ACTIVE;
- handlerPtr->handlerProc(handlerPtr->clientData, interp);
+ (handlerPtr->handlerProc)(handlerPtr->clientData, interp);
handlerPtr->flags &= ~LIMIT_HANDLER_ACTIVE;
/*
@@ -3422,9 +3240,9 @@ RunLimitHandlers(
if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
if (handlerPtr->deleteProc != NULL) {
- handlerPtr->deleteProc(handlerPtr->clientData);
+ (handlerPtr->deleteProc)(handlerPtr->clientData);
}
- ckfree(handlerPtr);
+ ckfree((char *) handlerPtr);
}
}
}
@@ -3471,7 +3289,7 @@ Tcl_LimitAddHandler(
* Allocate a handler record.
*/
- handlerPtr = ckalloc(sizeof(LimitHandler));
+ handlerPtr = (LimitHandler *) ckalloc(sizeof(LimitHandler));
handlerPtr->flags = 0;
handlerPtr->handlerProc = handlerProc;
handlerPtr->clientData = clientData;
@@ -3588,9 +3406,9 @@ Tcl_LimitRemoveHandler(
if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
if (handlerPtr->deleteProc != NULL) {
- handlerPtr->deleteProc(handlerPtr->clientData);
+ (handlerPtr->deleteProc)(handlerPtr->clientData);
}
- ckfree(handlerPtr);
+ ckfree((char *) handlerPtr);
}
return;
}
@@ -3648,9 +3466,9 @@ TclLimitRemoveAllHandlers(
if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
if (handlerPtr->deleteProc != NULL) {
- handlerPtr->deleteProc(handlerPtr->clientData);
+ (handlerPtr->deleteProc)(handlerPtr->clientData);
}
- ckfree(handlerPtr);
+ ckfree((char *) handlerPtr);
}
}
@@ -3681,9 +3499,9 @@ TclLimitRemoveAllHandlers(
if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
if (handlerPtr->deleteProc != NULL) {
- handlerPtr->deleteProc(handlerPtr->clientData);
+ (handlerPtr->deleteProc)(handlerPtr->clientData);
}
- ckfree(handlerPtr);
+ ckfree((char *) handlerPtr);
}
}
@@ -3946,7 +3764,7 @@ TimeLimitCallback(
code = Tcl_LimitCheck(interp);
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (while waiting for event)");
- Tcl_BackgroundException(interp, code);
+ TclBackgroundException(interp, code);
}
Tcl_Release(interp);
}
@@ -4078,7 +3896,7 @@ DeleteScriptLimitCallback(
if (limitCBPtr->entryPtr != NULL) {
Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
}
- ckfree(limitCBPtr);
+ ckfree((char *) limitCBPtr);
}
/*
@@ -4114,7 +3932,7 @@ CallScriptLimitCallback(
code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj,
TCL_EVAL_GLOBAL);
if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) {
- Tcl_BackgroundException(limitCBPtr->interp, code);
+ TclBackgroundException(limitCBPtr->interp, code);
}
Tcl_Release(limitCBPtr->interp);
}
@@ -4169,7 +3987,7 @@ SetScriptLimitCallback(
return;
}
- hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, &key,
+ hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, (char *) &key,
&isNew);
if (!isNew) {
limitCBPtr = Tcl_GetHashValue(hashPtr);
@@ -4178,7 +3996,7 @@ SetScriptLimitCallback(
limitCBPtr);
}
- limitCBPtr = ckalloc(sizeof(ScriptLimitCallback));
+ limitCBPtr = (ScriptLimitCallback *) ckalloc(sizeof(ScriptLimitCallback));
limitCBPtr->interp = interp;
limitCBPtr->scriptObj = scriptObj;
limitCBPtr->entryPtr = hashPtr;
@@ -4333,7 +4151,7 @@ SlaveCommandLimitCmd(
int objc, /* Total number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static const char *const options[] = {
+ static const char *options[] = {
"-command", "-granularity", "-value", NULL
};
enum Options {
@@ -4345,6 +4163,19 @@ SlaveCommandLimitCmd(
ScriptLimitCallback *limitCBPtr;
Tcl_HashEntry *hPtr;
+ /*
+ * First, ensure that we are not reading or writing the calling
+ * interpreter's limits; it may only manipulate its children. Note that
+ * the low level API enforces this with Tcl_Panic, which we want to
+ * avoid. [Bug 3398794]
+ */
+
+ if (interp == slaveInterp) {
+ Tcl_AppendResult(interp,
+ "limits on current interpreter inaccessible", NULL);
+ return TCL_ERROR;
+ }
+
if (objc == consumedObjc) {
Tcl_Obj *dictPtr;
@@ -4414,7 +4245,8 @@ SlaveCommandLimitCmd(
}
return TCL_OK;
} else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
- Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
+ Tcl_WrongNumArgs(interp, consumedObjc, objv,
+ "?-option? ?value? ?-option value ...?");
return TCL_ERROR;
} else {
int i, scriptLen = 0, limitLen = 0;
@@ -4439,8 +4271,6 @@ SlaveCommandLimitCmd(
if (gran < 1) {
Tcl_AppendResult(interp, "granularity must be at "
"least 1", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "BADVALUE", NULL);
return TCL_ERROR;
}
break;
@@ -4456,8 +4286,6 @@ SlaveCommandLimitCmd(
if (limit < 0) {
Tcl_AppendResult(interp, "command limit value must be at "
"least 0", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "BADVALUE", NULL);
return TCL_ERROR;
}
break;
@@ -4507,7 +4335,7 @@ SlaveTimeLimitCmd(
int objc, /* Total number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- static const char *const options[] = {
+ static const char *options[] = {
"-command", "-granularity", "-milliseconds", "-seconds", NULL
};
enum Options {
@@ -4519,6 +4347,19 @@ SlaveTimeLimitCmd(
ScriptLimitCallback *limitCBPtr;
Tcl_HashEntry *hPtr;
+ /*
+ * First, ensure that we are not reading or writing the calling
+ * interpreter's limits; it may only manipulate its children. Note that
+ * the low level API enforces this with Tcl_Panic, which we want to
+ * avoid. [Bug 3398794]
+ */
+
+ if (interp == slaveInterp) {
+ Tcl_AppendResult(interp,
+ "limits on current interpreter inaccessible", NULL);
+ return TCL_ERROR;
+ }
+
if (objc == consumedObjc) {
Tcl_Obj *dictPtr;
@@ -4605,7 +4446,8 @@ SlaveTimeLimitCmd(
}
return TCL_OK;
} else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
- Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
+ Tcl_WrongNumArgs(interp, consumedObjc, objv,
+ "?-option? ?value? ?-option value ...?");
return TCL_ERROR;
} else {
int i, scriptLen = 0, milliLen = 0, secLen = 0;
@@ -4634,8 +4476,6 @@ SlaveTimeLimitCmd(
if (gran < 1) {
Tcl_AppendResult(interp, "granularity must be at "
"least 1", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "BADVALUE", NULL);
return TCL_ERROR;
}
break;
@@ -4651,8 +4491,6 @@ SlaveTimeLimitCmd(
if (tmp < 0) {
Tcl_AppendResult(interp, "milliseconds must be at least 0",
NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "BADVALUE", NULL);
return TCL_ERROR;
}
limitMoment.usec = ((long)tmp)*1000;
@@ -4669,8 +4507,6 @@ SlaveTimeLimitCmd(
if (tmp < 0) {
Tcl_AppendResult(interp, "seconds must be at least 0",
NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "BADVALUE", NULL);
return TCL_ERROR;
}
limitMoment.sec = tmp;
@@ -4687,15 +4523,11 @@ SlaveTimeLimitCmd(
if (secObj != NULL && secLen == 0 && milliLen > 0) {
Tcl_AppendResult(interp, "may only set -milliseconds "
"if -seconds is not also being reset", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "BADUSAGE", NULL);
return TCL_ERROR;
}
if (milliLen == 0 && (secObj == NULL || secLen > 0)) {
Tcl_AppendResult(interp, "may only reset -milliseconds "
"if -seconds is also being reset", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
- "BADUSAGE", NULL);
return TCL_ERROR;
}
}
generated by cgit v0.12 at 2025-12-21 01:15:25 (GMT)