Attachment "iframe-tcl85.diff" to
ticket [3081184fff]
added by
andreas_kupries
2010-10-06 03:45:58.
--- tcl85.orig/doc/interp.n 2008-06-24 10:26:08.000000000 -0700
+++ tcl85/doc/interp.n 2010-10-04 14:19:07.000000000 -0700
@@ -168,6 +168,17 @@
The initial recursion limit of the slave interpreter is set to the
current recursion limit of its parent interpreter.
.TP
+\fBinterp\fR \fBdebug \fIpath\fR ?\fI\-frame\fR ?\fIbool\fR??
+.
+Controls whether frame-level stack information is captured in the
+slave interpreter identified by \fIpath\fR. If no arguments are
+given, option and current setting are returned. If \fI\-frame\fR
+is given, the debug setting is set to the given boolean if provided
+and the current setting is returned.
+This only effects the output of \fBinfo frame\fR, in that exact
+frame-level information for command invocation at the bytecode level
+is only captured with this setting on.
+.TP
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
Deletes zero or more interpreters given by the optional \fIpath\fR
arguments, and for each interpreter, it also deletes its slaves. The
--- tcl85.orig/doc/tclvars.n 2008-06-24 10:26:07.000000000 -0700
+++ tcl85/doc/tclvars.n 2010-10-05 13:37:14.000000000 -0700
@@ -49,6 +49,43 @@
same as unsetting it as this is the behavior of the underlying Windows OS.
It should be noted that relying on an existing and empty environment variable
will not work on Windows and is discouraged for cross-platform usage.
+.PP
+The following elements of \fBenv\fR are special to Tcl:
+.TP
+\fBenv(HOME)\fR
+.
+This environment variable, if set, gives the location of the directory
+considered to be the current user's home directory, and to which a
+call of \fBcd\fR without arguments or with just
+.QW ~
+as an argument will change into. Most platforms set this correctly by
+default; it does not normally need to be set by user code.
+.TP
+\fBenv(TCL_LIBRARY)\fR
+.
+If set, then it specifies the location of the directory containing
+library scripts (the value of this variable will be
+assigned to the \fBtcl_library\fR variable and therefore returned by
+the command \fBinfo library\fR). If this variable is not set then
+a default value is used.
+.RS
+.PP
+Note that this environment variable should \fInot\fR normally be set.
+.RE
+.TP
+\fBenv(TCLLIBPATH)\fR
+.
+If set, then it must contain a valid Tcl list giving directories to
+search during auto-load operations. Directories must be specified in
+Tcl format, using
+.QW /
+as the path separator, regardless of platform.
+This variable is only used when initializing the \fBauto_path\fR variable.
+.TP
+\fBenv(TCL_INTERP_DEBUG_FRAME)\fR
+.
+If existing, it has the same effect as running \fBinterp debug {} -frame 1\fR
+as the very first command of each new Tcl interpreter.
.RE
.TP
\fBerrorCode\fR
--- tcl85.orig/generic/tclBasic.c 2010-08-03 09:14:58.000000000 -0700
+++ tcl85/generic/tclBasic.c 2010-10-05 13:27:03.000000000 -0700
@@ -501,6 +501,15 @@
iPtr->resultSpace[0] = 0;
iPtr->threadId = Tcl_GetCurrentThread();
+ /* TIP #378 */
+#ifdef TCL_INTERP_DEBUG_FRAME
+ iPtr->flags |= INTERP_DEBUG_FRAME;
+#else
+ if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
+ iPtr->flags |= INTERP_DEBUG_FRAME;
+ }
+#endif
+
/*
* Initialise the tables for variable traces and searches *before*
* creating the global ns - so that the trace on errorInfo can be
@@ -3442,7 +3451,9 @@
TclInterpReady(
Tcl_Interp *interp)
{
+#if !defined(TCL_NO_STACK_CHECK)
int localInt; /* used for checking the stack */
+#endif
register Interp *iPtr = (Interp *) interp;
/*
--- tcl85.orig/generic/tclExecute.c 2010-10-04 15:49:12.000000000 -0700
+++ tcl85/generic/tclExecute.c 2010-10-04 15:56:18.000000000 -0700
@@ -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: tclExecute.c,v 1.369.2.17 2010/10/04 05:23:47 hobbs Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.369.2.16 2010/10/02 00:29:42 hobbs Exp $
*/
#include "tclInt.h"
@@ -2412,14 +2412,18 @@
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
TclArgumentBCEnter((Tcl_Interp*) iPtr, objv, objc,
codePtr, bcFramePtr, pc - codePtr->codeStart);
+ }
DECACHE_STACK_INFO();
result = TclEvalObjvInternal(interp, objc, objv,
/* call from TEBC */(char *) -1, -1, 0);
CACHE_STACK_INFO();
+ if (iPtr->flags & INTERP_DEBUG_FRAME) {
TclArgumentBCRelease((Tcl_Interp*) iPtr, objv, objc,
codePtr, pc - codePtr->codeStart);
+ }
iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
if (result == TCL_OK) {
@@ -8154,7 +8158,7 @@
Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
Tcl_AppendPrintfToObj(objPtr,
- "Compilation and execution statistics for interpreter %#lx\n",
+ "Compilation and execution statistics for interpreter 0x%p\n",
iPtr);
Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed %ld\n",
--- tcl85.orig/generic/tclInterp.c 2010-01-18 12:24:19.000000000 -0800
+++ tcl85/generic/tclInterp.c 2010-10-05 13:28:46.000000000 -0700
@@ -207,6 +207,9 @@
Tcl_Obj *const objv[]);
static Tcl_Interp * SlaveCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr,
int safe);
+static int SlaveDebugCmd(Tcl_Interp *interp,
+ Tcl_Interp *slaveInterp,
+ int objc, Tcl_Obj *const objv[]);
static int SlaveEval(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
int objc, Tcl_Obj *const objv[]);
static int SlaveExpose(Tcl_Interp *interp,
@@ -558,7 +561,7 @@
int index;
static const char *options[] = {
"alias", "aliases", "bgerror", "create",
- "delete", "eval", "exists", "expose",
+ "debug", "delete", "eval", "exists", "expose",
"hide", "hidden", "issafe", "invokehidden",
"limit", "marktrusted", "recursionlimit","slaves",
"share", "target", "transfer",
@@ -566,7 +569,7 @@
};
enum option {
OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_CREATE,
- OPT_DELETE, OPT_EVAL, OPT_EXISTS, OPT_EXPOSE,
+ OPT_DEBUG, OPT_DELETE, OPT_EVAL, OPT_EXISTS, OPT_EXPOSE,
OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE, OPT_INVOKEHID,
OPT_LIMIT, OPT_MARKTRUSTED,OPT_RECLIMIT, OPT_SLAVES,
OPT_SHARE, OPT_TARGET, OPT_TRANSFER
@@ -706,6 +709,23 @@
Tcl_SetObjResult(interp, slavePtr);
return TCL_OK;
}
+ case OPT_DEBUG: {
+ /* TIP #378 */
+ Tcl_Interp *slaveInterp;
+
+ /*
+ * Currently only -frame supported, otherwise ?-option ?value??
+ */
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??");
+ return TCL_ERROR;
+ }
+ slaveInterp = GetInterp(interp, objv[2]);
+ if (slaveInterp == NULL) {
+ return TCL_ERROR;
+ }
+ return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3);
+ }
case OPT_DELETE: {
int i;
InterpInfo *iiPtr;
@@ -2228,12 +2248,12 @@
Tcl_Interp *slaveInterp = clientData;
int index;
static const char *options[] = {
- "alias", "aliases", "bgerror", "eval",
+ "alias", "aliases", "bgerror", "debug", "eval",
"expose", "hide", "hidden", "issafe",
"invokehidden", "limit", "marktrusted", "recursionlimit", NULL
};
enum options {
- OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_EVAL,
+ OPT_ALIAS, OPT_ALIASES, OPT_BGERROR, OPT_DEBUG, OPT_EVAL,
OPT_EXPOSE, OPT_HIDE, OPT_HIDDEN, OPT_ISSAFE,
OPT_INVOKEHIDDEN, OPT_LIMIT, OPT_MARKTRUSTED, OPT_RECLIMIT
};
@@ -2280,6 +2300,16 @@
return TCL_ERROR;
}
return SlaveBgerror(interp, slaveInterp, objc - 2, objv + 2);
+ case OPT_DEBUG:
+ /*
+ * TIP #378 *
+ * Currently only -frame supported, otherwise ?-option ?value? ...?
+ */
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-frame ?bool??");
+ return TCL_ERROR;
+ }
+ return SlaveDebugCmd(interp, slaveInterp, objc - 2, objv + 2);
case OPT_EVAL:
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
@@ -2443,6 +2473,75 @@
/*
*----------------------------------------------------------------------
*
+ * SlaveDebugCmd -- TIP #378
+ *
+ * Helper function to handle 'debug' command in a slave interpreter.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May modify INTERP_DEBUG flag in the slave.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SlaveDebugCmd(
+ Tcl_Interp *interp, /* Interp for error return. */
+ Tcl_Interp *slaveInterp, /* The slave interpreter in which command
+ * will be evaluated. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const debugTypes[] = {
+ "-frame", NULL
+ };
+ enum DebugTypes {
+ DEBUG_TYPE_FRAME
+ };
+ int debugType;
+ Interp *iPtr;
+ Tcl_Obj *resultPtr;
+
+ iPtr = (Interp *) slaveInterp;
+ if (objc == 0) {
+ resultPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj("-frame", -1));
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
+ Tcl_SetObjResult(interp, resultPtr);
+ } else {
+ if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes,
+ "debug option", 0, &debugType) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (debugType == DEBUG_TYPE_FRAME) {
+ if (objc == 2) { /* set */
+ if (Tcl_GetBooleanFromObj(interp, objv[1], &debugType)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ /*
+ * Quietly ignore attempts to disable interp debugging.
+ * This is a one-way switch as frame debug info is maintained
+ * in a stack that must be consistent once turned on.
+ */
+ if (debugType) {
+ iPtr->flags |= INTERP_DEBUG_FRAME;
+ }
+ }
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* SlaveEval --
*
* Helper function to evaluate a command in a slave interpreter.
--- tcl85.orig/generic/tclInt.h 2010-08-03 09:14:58.000000000 -0700
+++ tcl85/generic/tclInt.h 2010-10-04 15:55:49.000000000 -0700
@@ -19,6 +19,8 @@
#ifndef _TCLINT
#define _TCLINT
+#define TCL_NO_STACK_CHECK /* DISABLE C RUNTIME STACK CHECK - Test AIX */
+
/*
* Some numerics configuration options.
*/
@@ -2032,6 +2034,9 @@
* SAFE_INTERP: Non zero means that the current interp is a safe
* interp (i.e. it has only the safe commands installed,
* less priviledge than a regular interp).
+ * INTERP_DEBUG_FRAME: Used for switching on various extra interpreter
+ * debug/info mechanisms (e.g. info frame eval/uplevel
+ * tracing) which are performance intensive.
* INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently
* active; so no further trace callbacks should be
* invoked.
@@ -2047,6 +2052,7 @@
#define DELETED 1
#define ERR_ALREADY_LOGGED 4
+#define INTERP_DEBUG_FRAME 0x10
#define DONT_COMPILE_CMDS_INLINE 0x20
#define RAND_SEED_INITIALIZED 0x40
#define SAFE_INTERP 0x80
--- tcl85.orig/tests/info.test 2010-08-03 09:50:49.000000000 -0700
+++ tcl85/tests/info.test 2010-10-05 10:00:03.000000000 -0700
@@ -689,7 +689,6 @@
##
# ### ### ### ######### ######### #########
## info frame
-
## Helper
# For the more complex results we cut the file name down to remove
# path dependencies, and we use only part of the first line of the
@@ -697,7 +696,6 @@
# test case may appear in some results, but the result is part of the
# testcase. An infinite string would be required to describe that. The
# cutting-down breaks this.
-
proc reduce {frame} {
set pos [lsearch -exact $frame cmd]
incr pos
@@ -714,7 +712,9 @@
}
set frame
}
-
+proc subinterp {} { interp create sub ; interp debug sub -frame 1;
+ interp eval sub [list proc reduce [info args reduce] [info body reduce]]
+}
## Helper
# Generate a stacktrace from the current location to top. This code
# not only depends on the exact location of things, but also on the
@@ -1364,14 +1364,14 @@
* {type eval line 3 cmd etrace proc ::tcltest::RunTest}
* {type source line 1362 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}}
-test info-38.2 {location information for uplevel, dl, direct-literal} -match glob -body {
- join [lrange [uplevel \#0 {
- set y DL.
- etrace
- }] 0 2] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type source line 1370 file info.test cmd etrace proc ::tcltest::RunTest}
-* {type source line 1368 file info.test cmd uplevel\\ \\\\ proc ::tcltest::RunTest}}
+# 38.2 moved to bottom to not disturb other tests with the necessary changes to this one.
+
+
+
+
+
+
+
test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match glob -body {
set script {
@@ -1384,15 +1384,15 @@
* {type source line 1339 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1381 file info.test cmd {control y $script} proc ::tcltest::RunTest}}
-test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -match glob -body {
- join [lrange [control y {
- set y DPL
- etrace
- }] 0 3] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type source line 1390 file info.test cmd etrace proc ::control}
-* {type source line 1339 file info.test cmd {uplevel 1 $script} proc ::control}
-* {type source line 1388 file info.test cmd control proc ::tcltest::RunTest}}
+# 38.4 moved to bottom to not disturb other tests with the necessary changes to this one.
+
+
+
+
+
+
+
+
test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glob -body {
join [lrange [datav] 0 4] \n
@@ -1402,13 +1402,13 @@
* {type source line 1354 file info.test cmd {control y $script} proc ::datav level 1}
* {type source line 1398 file info.test cmd datav proc ::tcltest::RunTest}}
-test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match glob -body {
- join [lrange [datal] 0 4] \n
-} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
-* {type source line 1345 file info.test cmd etrace proc ::control}
-* {type source line 1339 file info.test cmd {uplevel 1 $script} proc ::control}
-* {type source line 1343 file info.test cmd control proc ::datal level 1}
-* {type source line 1406 file info.test cmd datal proc ::tcltest::RunTest}}
+# 38.6 moved to bottom to not disturb other tests with the necessary changes to this one.
+
+
+
+
+
+
# -------------------------------------------------------------------------
# literal sharing
@@ -1536,18 +1536,18 @@
} { type source line 1534 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.13 {bs+nl in literal words, uplevel script, with nested words} {
- uplevel #0 {
+ subinterp ; set res [interp eval sub { uplevel #0 {
if {1} \
{
set ::res \
[reduce [info frame 0]];# line 1543
}
}
- set res
-} {type source line 1543 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+ set res }] ; interp delete sub ; set res
+} {type source line 1543 file info.test cmd {info frame 0} level 0}
test info-30.14 {bs+nl, literal word, uplevel through proc} {
- proc abra {script} {
+ subinterp ; set res [interp eval sub { proc abra {script} {
uplevel 1 $script
}
set res [abra {
@@ -1555,7 +1555,7 @@
[reduce [info frame 0]]";# line 1555
}]
rename abra {}
- set res
+ set res }] ; interp delete sub ; set res
} { type source line 1555 file info.test cmd {info frame 0} proc ::abra}
test info-30.15 {bs+nl in literal words, nested proc body, compiled} {
@@ -1742,6 +1742,81 @@
type source line 1722 file info.test cmd print_one proc ::test_info_frame level 1}
# -------------------------------------------------------------------------
+# Tests moved to the end to not disturb other tests and their locations.
+
+test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match glob -setup {subinterp} -body {
+ interp eval sub {
+ proc etrace {} {
+ set res {}
+ set level [info frame]
+ while {$level} {
+ lappend res [list $level [reduce [info frame $level]]]
+ incr level -1
+ }
+ return $res
+ }
+ proc control {vv script} {
+ upvar 1 $vv var
+ return [uplevel 1 $script]
+ }
+ proc datal {} {
+ control y {
+ set y PPL
+ etrace
+ }
+ }
+ join [lrange [datal] 0 4] \n
+ }
+} -result {* {type source line 1753 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1765 file info.test cmd etrace proc ::control}
+* {type source line 1760 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1763 file info.test cmd control proc ::datal level 1}
+* {type source line 1768 file info.test cmd datal level 2}} -cleanup {interp delete sub}
+
+test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -match glob -setup {subinterp} -body {
+ interp eval sub {
+ proc etrace {} {
+ set res {}
+ set level [info frame]
+ while {$level} {
+ lappend res [list $level [reduce [info frame $level]]]
+ incr level -1
+ }
+ return $res
+ }
+ proc control {vv script} {
+ upvar 1 $vv var
+ return [uplevel 1 $script]
+ }
+ join [lrange [control y {
+ set y DPL
+ etrace
+ }] 0 3] \n
+ }
+} -result {* {type source line 1782 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1793 file info.test cmd etrace proc ::control}
+* {type source line 1789 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1791 file info.test cmd control level 1}} -cleanup {interp delete sub}
+
+test info-38.2 {location information for uplevel, dl, direct-literal} -match glob -setup {subinterp} -body {
+ interp eval sub {
+ proc etrace {} {
+ set res {}
+ set level [info frame]
+ while {$level} {
+ lappend res [list $level [reduce [info frame $level]]]
+ incr level -1
+ }
+ return $res
+ }
+ join [lrange [uplevel \#0 {
+ set y DL.
+ etrace
+ }] 0 2] \n
+ }
+} -result {* {type source line 1807 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1814 file info.test cmd etrace level 1}
+* {type source line 1812 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub}
# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
--- tcl85.orig/tests/interp.test 2010-01-18 12:24:19.000000000 -0800
+++ tcl85/tests/interp.test 2010-10-04 15:52:10.000000000 -0700
@@ -31,7 +31,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, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "frobox": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.3 {options for interp command} {
interp delete
} ""
@@ -49,13 +49,13 @@
} {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, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "hello": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, 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, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, 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, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, 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"}}
@@ -3503,6 +3503,49 @@
interp delete a
} -result {26 26}
+test interp-38.1 {interp debug one-way switch} -setup {
+ catch {interp delete a}
+ interp create a
+ interp debug a -frame 1
+} -body {
+ # TIP #3xx interp debug frame is a one-way switch
+ interp debug a -frame 0
+} -cleanup {
+ interp delete a
+} -result {1}
+test interp-38.2 {interp debug env var} -setup {
+ catch {interp delete a}
+ set ::env(TCL_INTERP_DEBUG_FRAME) 1
+ interp create a
+} -body {
+ interp debug a
+} -cleanup {
+ unset ::env(TCL_INTERP_DEBUG_FRAME)
+ interp delete a
+} -result {-frame 1}
+test interp-38.3 {interp debug wrong args} -body {
+ interp debug
+} -returnCodes {
+ error
+} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}
+test interp-38.4 {interp debug basic setup} -body {
+ interp debug {}
+} -result {-frame 0}
+test interp-38.5 {interp debug basic setup} -body {
+ interp debug {} -f
+} -result {0}
+test interp-38.6 {interp debug basic setup} -body {
+ interp debug -frames
+} -returnCodes error -result {could not find interpreter "-frames"}
+test interp-38.7 {interp debug basic setup} -body {
+ interp debug {} -frames
+} -returnCodes error -result {bad debug option "-frames": must be -frame}
+test interp-38.8 {interp debug basic setup} -body {
+ interp debug {} -frame 0 bogus
+} -returnCodes {
+ error
+} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}
+
# cleanup
foreach i [interp slaves] {
interp delete $i
