Attachment "tip87dgp.patch" to
ticket [522849ffff]
added by
dgp
2002-03-07 08:17:58.
Index: doc/interp.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/interp.n,v
retrieving revision 1.7
diff -u -u -r1.7 interp.n
--- doc/interp.n 7 Aug 2001 02:54:30 -0000 1.7
+++ doc/interp.n 7 Mar 2002 01:02:37 -0000
@@ -147,6 +147,8 @@
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 @@
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 @@
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 @@
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
Index: generic/tclInterp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInterp.c,v
retrieving revision 1.11
diff -u -u -r1.11 tclInterp.c
--- generic/tclInterp.c 15 Feb 2002 14:28:49 -0000 1.11
+++ generic/tclInterp.c 7 Mar 2002 01:02:38 -0000
@@ -190,6 +190,10 @@
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 @@
"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 @@
}
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 @@
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 @@
}
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;
@@ -2092,6 +2118,65 @@
return TCL_ERROR;
}
return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ }
}
/*
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.46
diff -u -u -r1.46 tclTest.c
--- generic/tclTest.c 28 Feb 2002 00:38:49 -0000 1.46
+++ generic/tclTest.c 7 Mar 2002 01:02:39 -0000
@@ -301,9 +301,6 @@
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 @@
(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",
@@ -3283,47 +3277,6 @@
}
return TCL_OK;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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;
-}
-
-
/*
*----------------------------------------------------------------------
Index: tests/interp.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/interp.test,v
retrieving revision 1.13
diff -u -u -r1.13 interp.test
--- tests/interp.test 16 Nov 2001 22:28:08 -0000 1.13
+++ tests/interp.test 7 Mar 2002 01:02:40 -0000
@@ -37,7 +37,7 @@
} {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 @@
} {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 @@
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 @@
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 @@
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 @@
#} {}
# End of stack-recursion tests
-}
# This test dumps core in Tcl 8.0.3!
test interp-30.1 {deletion of aliases inside namespaces} {
