diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2008-07-31 00:43:06 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2008-07-31 00:43:06 (GMT) |
commit | 5ddf3538699df040576471a623bfc1f3c3c38bd3 (patch) | |
tree | 4c3c14d33de8f49b71c8d55554fb2ca7dc9c7a44 /generic/tclTest.c | |
parent | e251dd2937f9caaf882a32adb4d40f787a7e00d3 (diff) | |
download | tcl-5ddf3538699df040576471a623bfc1f3c3c38bd3.zip tcl-5ddf3538699df040576471a623bfc1f3c3c38bd3.tar.gz tcl-5ddf3538699df040576471a623bfc1f3c3c38bd3.tar.bz2 |
* generic/tclBasic.c: Improved tailcalls and tests.
* generic/tclCompile.h:
* generic/tclExecute.c:
* generic/tclTest.c:
* tests/NRE.test:
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r-- | generic/tclTest.c | 15 |
1 files changed, 12 insertions, 3 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index 4ce4277..1cb6714 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -14,11 +14,12 @@ * 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.119 2008/07/29 05:30:38 msofer Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.120 2008/07/31 00:43:10 msofer Exp $ */ #define TCL_TEST #include "tclInt.h" +#include "tclNRE.h" /* * Required for Testregexp*Cmd @@ -6545,7 +6546,9 @@ TestNRELevels( static ptrdiff_t *refDepth = NULL; ptrdiff_t depth; Tcl_Obj *levels[5]; - + int i = 0; + TEOV_callback *cbPtr = ((Interp *) interp)->execEnvPtr->callbackPtr; + if (refDepth == NULL) { refDepth = &depth; } @@ -6558,8 +6561,14 @@ TestNRELevels( levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level); levels[4] = Tcl_NewIntObj((iPtr->execEnvPtr->execStackPtr->tosPtr - iPtr->execEnvPtr->execStackPtr->stackWords)); + + while (cbPtr) { + i++; + cbPtr = cbPtr->nextPtr; + } + levels[5] = Tcl_NewIntObj(i); - Tcl_SetObjResult(interp, Tcl_NewListObj(5, levels)); + Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels)); return TCL_OK; } |