Attachment "tip87.patch" to
ticket [522849ffff]
added by
trier
2002-02-28 00:40:24.
*** ../orig/generic/tclInterp.c Fri Feb 15 09:28:49 2002
--- generic/tclInterp.c Wed Feb 27 11:29:10 2002
***************
*** 351,364 ****
"alias", "aliases", "create", "delete",
"eval", "exists", "expose", "hide",
"hidden", "issafe", "invokehidden", "marktrusted",
! "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
};
--- 351,366 ----
"alias", "aliases", "create", "delete",
"eval", "exists", "expose", "hide",
"hidden", "issafe", "invokehidden", "marktrusted",
! "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_RECLIMIT, OPT_SLAVES, OPT_SHARE,
! OPT_TARGET, OPT_TRANSFER
};
***************
*** 630,635 ****
--- 632,682 ----
}
return SlaveMarkTrusted(interp, slaveInterp);
}
+ case OPT_RECLIMIT: {
+ Tcl_Interp *slaveInterp;
+ Interp *iPtr;
+ int limit;
+
+ 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;
+ }
+ if (objc == 4) {
+ 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[3],
+ &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[3]);
+ return TCL_OK;
+ } else {
+ limit = Tcl_SetRecursionLimit(slaveInterp, 0);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(limit));
+ return TCL_OK;
+ }
+ }
case OPT_SLAVES: {
Tcl_Interp *slaveInterp;
InterpInfo *iiPtr;
***************
*** 1832,1843 ****
static CONST char *options[] = {
"alias", "aliases", "eval", "expose",
"hide", "hidden", "issafe", "invokehidden",
! "marktrusted", NULL
};
enum options {
OPT_ALIAS, OPT_ALIASES, OPT_EVAL, OPT_EXPOSE,
OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHIDDEN,
! OPT_MARKTRUSTED
};
slaveInterp = (Tcl_Interp *) clientData;
--- 1879,1890 ----
static CONST char *options[] = {
"alias", "aliases", "eval", "expose",
"hide", "hidden", "issafe", "invokehidden",
! "marktrusted", "recursionlimit", NULL
};
enum options {
OPT_ALIAS, OPT_ALIASES, OPT_EVAL, OPT_EXPOSE,
OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHIDDEN,
! OPT_MARKTRUSTED, OPT_RECLIMIT
};
slaveInterp = (Tcl_Interp *) clientData;
***************
*** 1954,1959 ****
--- 2001,2046 ----
return TCL_ERROR;
}
return SlaveMarkTrusted(interp, slaveInterp);
+ }
+ case OPT_RECLIMIT: {
+ Interp *iPtr;
+ int limit;
+
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ 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[2],
+ &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[2]);
+ return TCL_OK;
+ } else {
+ limit = Tcl_SetRecursionLimit(slaveInterp, 0);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(limit));
+ return TCL_OK;
+ }
}
}
*** ../orig/generic/tclTest.c Fri Feb 15 18:42:12 2002
--- generic/tclTest.c Tue Feb 26 12:43:06 2002
***************
*** 301,309 ****
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,
--- 301,306 ----
***************
*** 569,577 ****
(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",
--- 566,571 ----
***************
*** 3283,3329 ****
}
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;
- }
-
-
/*
*----------------------------------------------------------------------
--- 3277,3282 ----
*** ../orig/tests/interp.test Fri Nov 16 17:28:08 2001
--- tests/interp.test Wed Feb 27 12:30:35 2002
***************
*** 37,43 ****
} {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}}
test interp-1.3 {options for interp command} {
interp delete
} ""
--- 37,43 ----
} {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, recursionlimit, slaves, share, target, or transfer}}
test interp-1.3 {options for interp command} {
interp delete
} ""
***************
*** 55,71 ****
} {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}}
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}}
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}}
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
--- 55,72 ----
} {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, 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, 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, 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,454 ****
interp create {a x3 foo}
a eval x3 eval foo issafe
} 1
! test interp-7.6 {testing issafe arg checking} {
catch {interp create a}
list [catch {a issafe too many args} msg] $msg
} {1 {wrong # args: should be "a issafe"}}
--- 449,455 ----
interp create {a x3 foo}
a eval x3 eval foo issafe
} 1
! 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,2309 ****
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} {
set i [interp create]
- load {} Tcltest $i
set r [interp eval $i {
! testsetrecursionlimit 50
proc p {} {incr ::i; p}
set i 0
! catch p
! set i
}]
interp delete $i
set r
! } 49
! test interp-29.2 {recursion limit inheritance} {
set i [interp create]
- load {} Tcltest $i
set ii [interp eval $i {
! testsetrecursionlimit 50
interp create
}]
set r [interp eval [list $i $ii] {
--- 2279,2649 ----
set r
} {}
! # 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 {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.8 {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.9 {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.10 {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.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]
set r [interp eval $i {
! interp recursionlimit {} 50
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.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
! } {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.4.1 {recursion limit inheritance} {
set i [interp create]
set ii [interp eval $i {
! interp recursionlimit {} 50
interp create
}]
set r [interp eval [list $i $ii] {
***************
*** 2316,2321 ****
--- 2656,2807 ----
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,2345 ****
#} {}
# End of stack-recursion tests
- }
# This test dumps core in Tcl 8.0.3!
test interp-30.1 {deletion of aliases inside namespaces} {
--- 2825,2830 ----
*** ../orig/doc/interp.n Mon Aug 6 22:54:30 2001
--- doc/interp.n Tue Feb 26 13:33:43 2002
***************
*** 222,227 ****
--- 222,243 ----
already trusted.
.VE
.TP
+ \fBinterp\fR \fBrecursionlimit\fR \fIpath\fR ?\fInewlimit\fR?
+ Returns and optionally changes the maximum allowable nesting depth for
+ the interpreter specified by \fIpath\fR. If \fInewlimit\fR is supplied,
+ it becomes the new maximum number of nested calls to \fBTcl_Eval()\fR
+ and related procedures that may be made before an error occurs. It must
+ be a positive integer. If \fInewlimit\fR is not supplied, the command
+ returns the current recursion limit for the interpreter identified by
+ \fIpath\fR.
+ 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. When a sub-interpreter is created, its
+ initial recursion limit is the same as its parent's.
+ .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,354 ****
--- 365,385 ----
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 and optionally changes the maximum allowable nesting depth for the
+ slave interpreter. If \fInewlimit\fR is supplied, it becomes the new maximum
+ number of nested calls to \fBTcl_Eval()\fR and related functions that may be
+ made before an error occurs. It must be a positive integer. If
+ \fInewlimit\fR is not supplied, the command returns the current recursion
+ limit for the slave interpreter.
+ 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. When a slave interpreter is created, its
+ initial recursion limit is the same as its parent's.
.SH "SAFE INTERPRETERS"
.PP
***************
*** 450,455 ****
--- 481,489 ----
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
