diff options
Diffstat (limited to 'generic/tclInterp.c')
| -rw-r--r-- | generic/tclInterp.c | 95 |
1 files changed, 90 insertions, 5 deletions
diff --git a/generic/tclInterp.c b/generic/tclInterp.c index b7d07cb..c522607 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.11 2002/02/15 14:28:49 dkf Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.12 2002/03/07 20:17:22 dgp Exp $ */ #include "tclInt.h" @@ -190,6 +190,10 @@ static int SlaveObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Obj *CONST objv[])); static void SlaveObjCmdDeleteProc _ANSI_ARGS_(( ClientData clientData)); +static int SlaveRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Interp *slaveInterp, int objc, + Tcl_Obj *CONST objv[])); + /* *--------------------------------------------------------------------------- @@ -351,14 +355,16 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv) "alias", "aliases", "create", "delete", "eval", "exists", "expose", "hide", "hidden", "issafe", "invokehidden", "marktrusted", - "slaves", "share", "target", "transfer", + "recursionlimit", "slaves", "share", + "target", "transfer", NULL }; enum option { OPT_ALIAS, OPT_ALIASES, OPT_CREATE, OPT_DELETE, OPT_EVAL, OPT_EXISTS, OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID, OPT_MARKTRUSTED, - OPT_SLAVES, OPT_SHARE, OPT_TARGET, OPT_TRANSFER + OPT_RECLIMIT, OPT_SLAVES, OPT_SHARE, + OPT_TARGET, OPT_TRANSFER }; @@ -630,6 +636,19 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv) } return SlaveMarkTrusted(interp, slaveInterp); } + case OPT_RECLIMIT: { + Tcl_Interp *slaveInterp; + + if (objc != 3 && objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?"); + return TCL_ERROR; + } + slaveInterp = GetInterp(interp, objv[2]); + if (slaveInterp == NULL) { + return TCL_ERROR; + } + return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3); + } case OPT_SLAVES: { Tcl_Interp *slaveInterp; InterpInfo *iiPtr; @@ -1832,12 +1851,12 @@ SlaveObjCmd(clientData, interp, objc, objv) static CONST char *options[] = { "alias", "aliases", "eval", "expose", "hide", "hidden", "issafe", "invokehidden", - "marktrusted", NULL + "marktrusted", "recursionlimit", NULL }; enum options { OPT_ALIAS, OPT_ALIASES, OPT_EVAL, OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHIDDEN, - OPT_MARKTRUSTED + OPT_MARKTRUSTED, OPT_RECLIMIT }; slaveInterp = (Tcl_Interp *) clientData; @@ -1955,6 +1974,13 @@ SlaveObjCmd(clientData, interp, objc, objv) } return SlaveMarkTrusted(interp, slaveInterp); } + case OPT_RECLIMIT: { + if (objc != 2 && objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?"); + return TCL_ERROR; + } + return SlaveRecursionLimit(interp, slaveInterp, objc - 2, objv + 2); + } } return TCL_ERROR; @@ -2097,6 +2123,65 @@ SlaveExpose(interp, slaveInterp, objc, objv) /* *---------------------------------------------------------------------- * + * SlaveRecursionLimit -- + * + * Helper function to set/query the Recursion limit of an interp + * + * Results: + * A standard Tcl result. + * + * Side effects: + * When (objc == 1), slaveInterp will be set to a new recursion + * limit of objv[0]. + * + *---------------------------------------------------------------------- + */ + +static int +SlaveRecursionLimit(interp, slaveInterp, objc, objv) + Tcl_Interp *interp; /* Interp for error return. */ + Tcl_Interp *slaveInterp; /* Interp in which limit is set/queried. */ + int objc; /* Set or Query. */ + Tcl_Obj *CONST objv[]; /* Argument strings. */ +{ + Interp *iPtr; + int limit; + + if (objc) { + if (Tcl_IsSafe(interp)) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "permission denied: ", + "safe interpreters cannot change recursion limit", + (char *) NULL); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { + return TCL_ERROR; + } + if (limit <= 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "recursion limit must be > 0", -1)); + return TCL_ERROR; + } + Tcl_SetRecursionLimit(slaveInterp, limit); + iPtr = (Interp *) slaveInterp; + if (interp == slaveInterp && iPtr->numLevels > limit) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "falling back due to new recursion limit", -1)); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, objv[0]); + return TCL_OK; + } else { + limit = Tcl_SetRecursionLimit(slaveInterp, 0); + Tcl_SetObjResult(interp, Tcl_NewIntObj(limit)); + return TCL_OK; + } +} + +/* + *---------------------------------------------------------------------- + * * SlaveHide -- * * Helper function to hide a command in a slave interpreter. |