* Added the [interp recursionlimit] command to

        set/query the recursion limit of an interpreter.  Proposal and
        implementation from Stephen Trier. [TIP 87, Patch 522849]

2 files changed, 91 insertions, 53 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.
diff --git a/generic/tclTest.c b/generic/tclTest.c
index e80818e..5aeff82 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.46 2002/02/28 00:38:49 hobbs Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.47 2002/03/07 20:17:22 dgp Exp $
  */
 
 #define TCL_TEST
@@ -301,9 +301,6 @@ static int		TestopenfilechannelprocCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		TestsetplatformCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
-static int		TestsetrecursionlimitCmd _ANSI_ARGS_((
-                            ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]));
 static int		TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int argc, char **argv));
 static int		PretendTclpStat _ANSI_ARGS_((CONST char *path,
@@ -569,9 +566,6 @@ Tcltest_Init(interp)
 	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
 	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateObjCommand(interp, "testsetrecursionlimit",
-	    TestsetrecursionlimitCmd,
-	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
 	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testtranslatefilename",
@@ -3287,47 +3281,6 @@ TestsetplatformCmd(clientData, interp, argc, argv)
 /*
  *----------------------------------------------------------------------
  *
- * TestsetrecursionlimitCmd --
- *
- *	This procedure implements the "testsetrecursionlimit" command. It is
- *	used to change the interp recursion limit (to test the effects
- *      of Tcl_SetRecursionLimit).
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Sets the interp's recursion limit.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestsetrecursionlimitCmd(dummy, interp, objc, objv)
-    ClientData dummy;		/* Not used. */
-    Tcl_Interp *interp;		/* Current interpreter. */
-    int objc;			/* Number of arguments. */
-    Tcl_Obj *CONST objv[];	/* The argument objects. */
-{
-    int     value;
-
-    if (objc != 2) {
-    	Tcl_WrongNumArgs(interp, 1, objv, "integer");
-	return TCL_ERROR;
-    }
-    if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    value = Tcl_SetRecursionLimit(interp, value);
-    Tcl_SetIntObj(Tcl_GetObjResult(interp), value);
-    return TCL_OK;
-}
-
-
-
-/*
- *----------------------------------------------------------------------
- *
  * TeststaticpkgCmd --
  *
  *	This procedure implements the "teststaticpkg" command.