summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2002-03-07 20:17:22 (GMT)
committerdgp <dgp@users.sourceforge.net>2002-03-07 20:17:22 (GMT)
commit55889909abdf66ad1c7b86b10244d9dd09cc46e2 (patch)
tree184910b8ad72de98f7e7ac866aca918781e3afb7
parentc28bf1192da9e92b14a27884bdc517cc6fb37d54 (diff)
downloadtcl-55889909abdf66ad1c7b86b10244d9dd09cc46e2.zip
tcl-55889909abdf66ad1c7b86b10244d9dd09cc46e2.tar.gz
tcl-55889909abdf66ad1c7b86b10244d9dd09cc46e2.tar.bz2
* Added the [interp recursionlimit] command to
set/query the recursion limit of an interpreter. Proposal and implementation from Stephen Trier. [TIP 87, Patch 522849]
-rw-r--r--ChangeLog11
-rw-r--r--doc/interp.n41
-rw-r--r--generic/tclInterp.c95
-rw-r--r--generic/tclTest.c49
-rw-r--r--tests/interp.test545
5 files changed, 662 insertions, 79 deletions
diff --git a/ChangeLog b/ChangeLog
index 9569244..8cc2eaa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2002-03-07 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/interp.n:
+ * generic/tclInterp.c(Tcl_InterpObjCmd,SlaveObjCmd,SlaveRecursionLimit):
+ * generic/tclTest.c:
+ * tests/interp.test: Added the [interp recursionlimit] command to
+ set/query the recursion limit of an interpreter. Proposal and
+ implementation from Stephen Trier. [TIP 87, Patch 522849]
+
2002-03-06 Donal K. Fellows <fellowsd@cs.man.ac.uk>
* generic/tcl.h, tools/tcl.wse.in, unix/configure.in,
@@ -86,8 +95,8 @@
2002-02-28 Miguel Sofer <msofer@users.sourceforge.net>
- * generic/tclExecute.c: Replaced a few direct stack accesses
with the POP_OBJECT() macro [Bug 507181] (Don Porter).
+ * generic/tclExecute.c: Replaced a few direct stack accesses
2002-02-27 Don Porter <dgp@users.sourceforge.net>
diff --git a/doc/interp.n b/doc/interp.n
index 52d3bfd..e753299 100644
--- a/doc/interp.n
+++ b/doc/interp.n
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: interp.n,v 1.7 2001/08/07 02:54:30 hobbs Exp $
+'\" RCS: @(#) $Id: interp.n,v 1.8 2002/03/07 20:17:22 dgp Exp $
'\"
.so man.macros
.TH interp n 7.6 Tcl "Tcl Built-In Commands"
@@ -147,6 +147,8 @@ value such as \fB\-safe\fR. The result of the command is the name of the
new interpreter. The name of a slave interpreter must be unique among all
the slaves for its master; an error occurs if a slave interpreter by the
given name already exists in this master.
+The initial recursion limit of the slave interpreter is set to the
+current recursion limit of its parent interpreter.
.TP
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
Deletes zero or more interpreters given by the optional \fIpath\fR
@@ -222,6 +224,23 @@ The command has no effect if the interpreter identified by \fIpath\fR is
already trusted.
.VE
.TP
+\fBinterp\fR \fBrecursionlimit\fR \fIpath\fR ?\fInewlimit\fR?
+Returns the maximum allowable nesting depth for the interpreter
+specified by \fIpath\fR. If \fInewlimit\fR is specified,
+the interpreter recursion limit will be set so that nesting
+of more than \fInewlimit\fR calls to \fBTcl_Eval()\fR
+and related procedures in that interpreter will return an error.
+The \fInewlimit\fR value is also returned.
+The \fInewlimit\fR value must be a positive integer between 1 and the
+maximum value of a non-long integer on the platform.
+.sp
+The command sets the maximum size of the Tcl call stack only. It cannot
+by itself prevent stack overflows on the C stack being used by the
+application. If your machine has a limit on the size of the C stack, you
+may get stack overflows before reaching the limit set by the command. If
+this happens, see if there is a mechanism in your system for increasing
+the maximum size of the C stack.
+.TP
\fBinterp\fR \fBshare\fR \fIsrcPath channelId destPath\fR
Causes the IO channel identified by \fIchannelId\fR to become shared
between the interpreter identified by \fIsrcPath\fR and the interpreter
@@ -349,7 +368,22 @@ trusted interpreter. This command does not expose any hidden
commands in the slave interpreter. The command has no effect if the slave
is already trusted.
.VE
-
+.TP
+\fIslave\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
+Returns the maximum allowable nesting depth for the \fIslave\fR interpreter.
+If \fInewlimit\fR is specified, the recursion limit in \fIslave\fR will be
+set so that nesting of more than \fInewlimit\fR calls to \fBTcl_Eval()\fR
+and related procedures in \fIslave\fR will return an error.
+The \fInewlimit\fR value is also returned.
+The \fInewlimit\fR value must be a positive integer between 1 and the
+maximum value of a non-long integer on the platform.
+.sp
+The command sets the maximum size of the Tcl call stack only. It cannot
+by itself prevent stack overflows on the C stack being used by the
+application. If your machine has a limit on the size of the C stack, you
+may get stack overflows before reaching the limit set by the command. If
+this happens, see if there is a mechanism in your system for increasing
+the maximum size of the C stack.
.SH "SAFE INTERPRETERS"
.PP
A safe interpreter is one with restricted functionality, so that
@@ -450,6 +484,9 @@ If extensions are loaded into a safe interpreter, they may also restrict
their own functionality to eliminate unsafe commands. For a discussion of
management of extensions for safety see the manual entries for
\fBSafe\-Tcl\fR and the \fBload\fR Tcl command.
+.PP
+A safe interpreter may not alter the recursion limit of any interpreter,
+including itself.
.SH "ALIAS INVOCATION"
.PP
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.
diff --git a/tests/interp.test b/tests/interp.test
index 5d72a7b..43eb266 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: interp.test,v 1.13 2001/11/16 22:28:08 hobbs Exp $
+# RCS: @(#) $Id: interp.test,v 1.14 2002/03/07 20:17:23 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -37,7 +37,7 @@ test interp-1.1 {options for interp command} {
} {1 {wrong # args: should be "interp cmd ?arg ...?"}}
test interp-1.2 {options for interp command} {
list [catch {interp frobox} msg] $msg
-} {1 {bad option "frobox": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
+} {1 {bad option "frobox": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.3 {options for interp command} {
interp delete
} ""
@@ -55,17 +55,18 @@ test interp-1.6 {options for interp command} {
} {1 {wrong # args: should be "interp slaves ?path?"}}
test interp-1.7 {options for interp command} {
list [catch {interp hello} msg] $msg
-} {1 {bad option "hello": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
+} {1 {bad option "hello": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.8 {options for interp command} {
list [catch {interp -froboz} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.9 {options for interp command} {
list [catch {interp -froboz -safe} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.10 {options for interp command} {
list [catch {interp target} msg] $msg
} {1 {wrong # args: should be "interp target path alias"}}
+
# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
interp create a
@@ -448,7 +449,7 @@ test interp-13.3 {testing foo issafe} {
interp create {a x3 foo}
a eval x3 eval foo issafe
} 1
-test interp-7.6 {testing issafe arg checking} {
+test interp-13.4 {testing issafe arg checking} {
catch {interp create a}
list [catch {a issafe too many args} msg] $msg
} {1 {wrong # args: should be "a issafe"}}
@@ -2278,32 +2279,385 @@ test interp-28.1 {getting fooled by slave's namespace ?} {
set r
} {}
-# Tests of recursionlimit
-# We need testsetrecursionlimit so we need Tcltest package
-if {[catch {package require Tcltest} msg]} {
- puts "This application hasn't been compiled with Tcltest"
- puts "skipping remining interp tests that relies on it."
-} else {
- #
-test interp-29.1 {recursion limit} {
+# Part 29: recursion limit
+# 29.1.* Argument checking
+# 29.2.* Reading and setting the recursion limit
+# 29.3.* Does the recursion limit work?
+# 29.4.* Recursion limit inheritance by sub-interpreters
+# 29.5.* Confirming the recursionlimit command does not affect the parent
+# 29.6.* Safe interpreter restriction
+
+test interp-29.1.1 {interp recursionlimit argument checking} {
+ list [catch {interp recursionlimit} msg] $msg
+} {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}
+
+test interp-29.1.2 {interp recursionlimit argument checking} {
+ list [catch {interp recursionlimit foo bar} msg] $msg
+} {1 {could not find interpreter "foo"}}
+
+test interp-29.1.3 {interp recursionlimit argument checking} {
+ list [catch {interp recursionlimit foo bar baz} msg] $msg
+} {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}
+
+test interp-29.1.4 {interp recursionlimit argument checking} {
+ interp create moo
+ set result [catch {interp recursionlimit moo bar} msg]
+ interp delete moo
+ list $result $msg
+} {1 {expected integer but got "bar"}}
+
+test interp-29.1.5 {interp recursionlimit argument checking} {
+ interp create moo
+ set result [catch {interp recursionlimit moo 0} msg]
+ interp delete moo
+ list $result $msg
+} {1 {recursion limit must be > 0}}
+
+test interp-29.1.6 {interp recursionlimit argument checking} {
+ interp create moo
+ set result [catch {interp recursionlimit moo -1} msg]
+ interp delete moo
+ list $result $msg
+} {1 {recursion limit must be > 0}}
+
+test interp-29.1.7 {interp recursionlimit argument checking} {
+ interp create moo
+ set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg]
+ interp delete moo
+ list $result [string range $msg 0 35]
+} {1 {integer value too large to represent}}
+
+test interp-29.1.8 {slave recursionlimit argument checking} {
+ interp create moo
+ set result [catch {moo recursionlimit foo bar} msg]
+ interp delete moo
+ list $result $msg
+} {1 {wrong # args: should be "moo recursionlimit ?newlimit?"}}
+
+test interp-29.1.9 {slave recursionlimit argument checking} {
+ interp create moo
+ set result [catch {moo recursionlimit foo} msg]
+ interp delete moo
+ list $result $msg
+} {1 {expected integer but got "foo"}}
+
+test interp-29.1.10 {slave recursionlimit argument checking} {
+ interp create moo
+ set result [catch {moo recursionlimit 0} msg]
+ interp delete moo
+ list $result $msg
+} {1 {recursion limit must be > 0}}
+
+test interp-29.1.11 {slave recursionlimit argument checking} {
+ interp create moo
+ set result [catch {moo recursionlimit -1} msg]
+ interp delete moo
+ list $result $msg
+} {1 {recursion limit must be > 0}}
+
+test interp-29.1.12 {slave recursionlimit argument checking} {
+ interp create moo
+ set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg]
+ interp delete moo
+ list $result [string range $msg 0 35]
+} {1 {integer value too large to represent}}
+
+test interp-29.2.1 {query recursion limit} {
+ interp recursionlimit {}
+} 1000
+
+test interp-29.2.2 {query recursion limit} {
+ set i [interp create]
+ set n [interp recursionlimit $i]
+ interp delete $i
+ set n
+} 1000
+
+test interp-29.2.3 {query recursion limit} {
+ set i [interp create]
+ set n [$i recursionlimit]
+ interp delete $i
+ set n
+} 1000
+
+test interp-29.2.4 {query recursion limit} {
+ set i [interp create]
+ set r [$i eval {
+ set n1 [interp recursionlimit {} 42]
+ set n2 [interp recursionlimit {}]
+ list $n1 $n2
+ }]
+ interp delete $i
+ set r
+} {42 42}
+
+test interp-29.2.5 {query recursion limit} {
+ set i [interp create]
+ set n1 [interp recursionlimit $i 42]
+ set n2 [interp recursionlimit $i]
+ interp delete $i
+ list $n1 $n2
+} {42 42}
+
+test interp-29.2.6 {query recursion limit} {
+ set i [interp create]
+ set n1 [interp recursionlimit $i 42]
+ set n2 [$i recursionlimit]
+ interp delete $i
+ list $n1 $n2
+} {42 42}
+
+test interp-29.2.7 {query recursion limit} {
+ set i [interp create]
+ set n1 [$i recursionlimit 42]
+ set n2 [interp recursionlimit $i]
+ interp delete $i
+ list $n1 $n2
+} {42 42}
+
+test interp-29.2.8 {query recursion limit} {
+ set i [interp create]
+ set n1 [$i recursionlimit 42]
+ set n2 [$i recursionlimit]
+ interp delete $i
+ list $n1 $n2
+} {42 42}
+
+test interp-29.3.1 {recursion limit} {
set i [interp create]
- load {} Tcltest $i
set r [interp eval $i {
- testsetrecursionlimit 50
+ interp recursionlimit {} 50
proc p {} {incr ::i; p}
set i 0
- catch p
- set i
+ list [catch p msg] $msg $i
+ }]
+ interp delete $i
+ set r
+} {1 {too many nested calls to Tcl_Eval (infinite loop?)} 48}
+
+test interp-29.3.2 {recursion limit} {
+ set i [interp create]
+ interp recursionlimit $i 50
+ set r [interp eval $i {
+ proc p {} {incr ::i; p}
+ set i 0
+ list [catch p msg] $msg $i
}]
interp delete $i
set r
-} 49
+} {1 {too many nested calls to Tcl_Eval (infinite loop?)} 48}
+
+test interp-29.3.3 {recursion limit} {
+ set i [interp create]
+ $i recursionlimit 50
+ set r [interp eval $i {
+ proc p {} {incr ::i; p}
+ set i 0
+ list [catch p msg] $msg $i
+ }]
+ interp delete $i
+ set r
+} {1 {too many nested calls to Tcl_Eval (infinite loop?)} 48}
+
+test interp-29.3.4 {recursion limit error reporting} {
+ interp create slave
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ interp recursionlimit {} 5
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {1 {falling back due to new recursion limit}}
+
+test interp-29.3.5 {recursion limit error reporting} {
+ interp create slave
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ interp recursionlimit {} 4
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {1 {falling back due to new recursion limit}}
+
+test interp-29.3.6 {recursion limit error reporting} {
+ interp create slave
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ interp recursionlimit {} 6
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+
+test interp-29.3.7 {recursion limit error reporting} {
+ interp create slave
+ after 0 {interp recursionlimit slave 5}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {1 {too many nested calls to Tcl_Eval (infinite loop?)}}
+
+test interp-29.3.8 {recursion limit error reporting} {
+ interp create slave
+ after 0 {interp recursionlimit slave 4}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {1 {too many nested calls to Tcl_Eval (infinite loop?)}}
+
+test interp-29.3.9 {recursion limit error reporting} {
+ interp create slave
+ after 0 {interp recursionlimit slave 6}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
+
+test interp-29.3.10 {recursion limit error reporting} {
+ interp create slave
+ after 0 {slave recursionlimit 4}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {1 {too many nested calls to Tcl_Eval (infinite loop?)}}
+
+test interp-29.3.11 {recursion limit error reporting} {
+ interp create slave
+ after 0 {slave recursionlimit 5}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {1 {too many nested calls to Tcl_Eval (infinite loop?)}}
+
+test interp-29.3.12 {recursion limit error reporting} {
+ interp create slave
+ after 0 {slave recursionlimit 6}
+ set r1 [slave eval {
+ catch { # nesting level 1
+ eval { # 2
+ eval { # 3
+ eval { # 4
+ eval { # 5
+ update
+ set x ok
+ }
+ }
+ }
+ }
+ } msg
+ }]
+ set r2 [slave eval { set msg }]
+ interp delete slave
+ list $r1 $r2
+} {0 ok}
-test interp-29.2 {recursion limit inheritance} {
+test interp-29.4.1 {recursion limit inheritance} {
set i [interp create]
- load {} Tcltest $i
set ii [interp eval $i {
- testsetrecursionlimit 50
+ interp recursionlimit {} 50
interp create
}]
set r [interp eval [list $i $ii] {
@@ -2316,6 +2670,152 @@ test interp-29.2 {recursion limit inheritance} {
set r
} 49
+test interp-29.4.2 {recursion limit inheritance} {
+ set i [interp create]
+ $i recursionlimit 50
+ set ii [interp eval $i {interp create}]
+ set r [interp eval [list $i $ii] {
+ proc p {} {incr ::i; p}
+ set i 0
+ catch p
+ set i
+ }]
+ interp delete $i
+ set r
+} 49
+
+test interp-29.5.1 {does slave recursion limit affect master?} {
+ set before [interp recursionlimit {}]
+ set i [interp create]
+ interp recursionlimit $i 20000
+ set after [interp recursionlimit {}]
+ set slavelimit [interp recursionlimit $i]
+ interp delete $i
+ list [expr {$before == $after}] $slavelimit
+} {1 20000}
+
+test interp-29.5.2 {does slave recursion limit affect master?} {
+ set before [interp recursionlimit {}]
+ set i [interp create]
+ interp recursionlimit $i 20000
+ set after [interp recursionlimit {}]
+ set slavelimit [$i recursionlimit]
+ interp delete $i
+ list [expr {$before == $after}] $slavelimit
+} {1 20000}
+
+test interp-29.5.3 {does slave recursion limit affect master?} {
+ set before [interp recursionlimit {}]
+ set i [interp create]
+ $i recursionlimit 20000
+ set after [interp recursionlimit {}]
+ set slavelimit [interp recursionlimit $i]
+ interp delete $i
+ list [expr {$before == $after}] $slavelimit
+} {1 20000}
+
+test interp-29.5.4 {does slave recursion limit affect master?} {
+ set before [interp recursionlimit {}]
+ set i [interp create]
+ $i recursionlimit 20000
+ set after [interp recursionlimit {}]
+ set slavelimit [$i recursionlimit]
+ interp delete $i
+ list [expr {$before == $after}] $slavelimit
+} {1 20000}
+
+test interp-29.6.1 {safe interpreter recursion limit} {
+ interp create slave -safe
+ set n [interp recursionlimit slave]
+ interp delete slave
+ set n
+} 1000
+
+test interp-29.6.2 {safe interpreter recursion limit} {
+ interp create slave -safe
+ set n [slave recursionlimit]
+ interp delete slave
+ set n
+} 1000
+
+test interp-29.6.3 {safe interpreter recursion limit} {
+ interp create slave -safe
+ set n1 [interp recursionlimit slave 42]
+ set n2 [interp recursionlimit slave]
+ interp delete slave
+ list $n1 $n2
+} {42 42}
+
+test interp-29.6.4 {safe interpreter recursion limit} {
+ interp create slave -safe
+ set n1 [slave recursionlimit 42]
+ set n2 [interp recursionlimit slave]
+ interp delete slave
+ list $n1 $n2
+} {42 42}
+
+test interp-29.6.5 {safe interpreter recursion limit} {
+ interp create slave -safe
+ set n1 [interp recursionlimit slave 42]
+ set n2 [slave recursionlimit]
+ interp delete slave
+ list $n1 $n2
+} {42 42}
+
+test interp-29.6.6 {safe interpreter recursion limit} {
+ interp create slave -safe
+ set n1 [slave recursionlimit 42]
+ set n2 [slave recursionlimit]
+ interp delete slave
+ list $n1 $n2
+} {42 42}
+
+test interp-29.6.7 {safe interpreter recursion limit} {
+ interp create slave -safe
+ set n1 [slave recursionlimit 42]
+ set n2 [slave recursionlimit]
+ interp delete slave
+ list $n1 $n2
+} {42 42}
+
+test interp-29.6.8 {safe interpreter recursion limit} {
+ interp create slave -safe
+ set n [catch {slave eval {interp recursionlimit {} 42}} msg]
+ interp delete slave
+ list $n $msg
+} {1 {permission denied: safe interpreters cannot change recursion limit}}
+
+test interp-29.6.9 {safe interpreter recursion limit} {
+ interp create slave -safe
+ set result [
+ slave eval {
+ interp create slave2 -safe
+ set n [catch {
+ interp recursionlimit slave2 42
+ } msg]
+ list $n $msg
+ }
+ ]
+ interp delete slave
+ set result
+} {1 {permission denied: safe interpreters cannot change recursion limit}}
+
+test interp-29.6.10 {safe interpreter recursion limit} {
+ interp create slave -safe
+ set result [
+ slave eval {
+ interp create slave2 -safe
+ set n [catch {
+ slave2 recursionlimit 42
+ } msg]
+ list $n $msg
+ }
+ ]
+ interp delete slave
+ set result
+} {1 {permission denied: safe interpreters cannot change recursion limit}}
+
+
# # Deep recursion (into interps when the regular one fails):
# # still crashes...
# proc p {} {
@@ -2339,7 +2839,6 @@ test interp-29.2 {recursion limit inheritance} {
#} {}
# End of stack-recursion tests
-}
# This test dumps core in Tcl 8.0.3!
test interp-30.1 {deletion of aliases inside namespaces} {