diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | doc/interp.n | 41 | ||||
| -rw-r--r-- | generic/tclInterp.c | 95 | ||||
| -rw-r--r-- | generic/tclTest.c | 49 | ||||
| -rw-r--r-- | tests/interp.test | 545 |
5 files changed, 662 insertions, 79 deletions
@@ -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} { |