From b2d9ed24c8428b9c2230515bf13aa76dcfdb607f Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Wed, 10 Sep 2008 13:23:47 +0000 Subject: * tests/nre.test: add missing constraints; enable test of foreach recursion. * generic/tclBasic.c: * generic/tclCompile.h: * generic/tclExecute.c (INST_EVAL_STK): fix for [Bug 2102930], wrong numLevels when evaling a canonical list. --- ChangeLog | 10 ++++++++++ generic/tclBasic.c | 5 ++--- generic/tclCompile.h | 3 ++- generic/tclExecute.c | 9 ++++++++- tests/nre.test | 49 ++++++++++++++++++++++++++++++++++++++++++++++--- 5 files changed, 68 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index 558d591..5c412e3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2008-09-10 Miguel Sofer + + * tests/nre.test: add missing constraints; enable test of foreach + recursion. + + * generic/tclBasic.c: + * generic/tclCompile.h: + * generic/tclExecute.c (INST_EVAL_STK): fix for [Bug 2102930], + wrong numLevels when evaling a canonical list. + 2008-09-10 Donal K. Fellows * generic/tclListObj.c (Tcl_ListObjGetElements): Make this list->dict diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 68700c8..1f80d43 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.365 2008/08/26 22:37:02 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.366 2008/09/10 13:24:00 msofer Exp $ */ #include "tclInt.h" @@ -134,7 +134,6 @@ static Tcl_NRPostProc TEOV_Error; static Tcl_NRPostProc TEOEx_ListCallback; static Tcl_NRPostProc TEOEx_ByteCodeCallback; -static Tcl_NRPostProc NRCommand; static Tcl_NRPostProc NRRunObjProc; static Tcl_NRPostProc AtProcExitCleanup; @@ -4228,7 +4227,7 @@ TclNRRunCallbacks( return result; } -static int +int NRCommand( ClientData data[], Tcl_Interp *interp, diff --git a/generic/tclCompile.h b/generic/tclCompile.h index c7539ba..ab8eef8 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -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: tclCompile.h,v 1.106 2008/08/17 19:37:11 msofer Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.107 2008/09/10 13:24:09 msofer Exp $ */ #ifndef _TCLCOMPILATION @@ -838,6 +838,7 @@ typedef struct { */ MODULE_SCOPE Tcl_NRPostProc NRCallTEBC; +MODULE_SCOPE Tcl_NRPostProc NRCommand; #define TCL_NR_BC_TYPE 0 #define TCL_NR_ATEXIT_TYPE 1 diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 326cc18..ba7bd62 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,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.410 2008/09/08 03:55:21 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.411 2008/09/10 13:24:12 msofer Exp $ */ #include "tclInt.h" @@ -2700,6 +2700,13 @@ TclExecuteByteCode( } objc = listRepPtr->elemCount; objv = &listRepPtr->elements; + + /* + * Fix for [Bug 2102930] + */ + + iPtr->numLevels++; + Tcl_NRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); goto doInvocationFromEval; } } diff --git a/tests/nre.test b/tests/nre.test index c415150..ef2802f 100644 --- a/tests/nre.test +++ b/tests/nre.test @@ -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: nre.test,v 1.5 2008/09/01 12:28:10 msofer Exp $ +# RCS: @(#) $Id: nre.test,v 1.6 2008/09/10 13:24:26 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -69,6 +69,8 @@ test nre-1.1 {self-recursive procs} -setup { } -cleanup { rename a {} unset abs +} -constraints { + testnrelevels } -result {{0 1 1 1} 0} test nre-1.2 {self-recursive lambdas} -setup { @@ -78,6 +80,8 @@ test nre-1.2 {self-recursive lambdas} -setup { apply $a 0 } -cleanup { unset a abs +} -constraints { + testnrelevels } -result {{0 1 1 1} 0} test nre-1.3 {mutually recursive procs and lambdas} -setup { @@ -91,6 +95,8 @@ test nre-1.3 {mutually recursive procs and lambdas} -setup { } -cleanup { rename a {} unset b abs +} -constraints { + testnrelevels } -result {{0 2 2 2} 0} # @@ -107,6 +113,8 @@ test nre-2.1 {alias is not recursive} -setup { rename a {} rename b {} unset abs +} -constraints { + testnrelevels } -result {{0 2 1 1} 0} # @@ -125,6 +133,8 @@ test nre-3.1 {imports are not recursive} -setup { } -cleanup { rename a {} namespace delete ::foo +} -constraints { + testnrelevels } -result {{0 2 1 1} 0} test nre-4.1 {ensembles are not recursive} -setup { @@ -139,6 +149,8 @@ test nre-4.1 {ensembles are not recursive} -setup { rename a {} rename b {} unset abs +} -constraints { + testnrelevels } -result {{0 2 1 1} 0} test nre-5.1 {[namespace eval] is not recursive} -setup { @@ -150,6 +162,8 @@ test nre-5.1 {[namespace eval] is not recursive} -setup { ::foo::a 0 } -cleanup { namespace delete ::foo +} -constraints { + testnrelevels } -result {{0 2 2 2} 0} test nre-5.2 {[namespace eval] is not recursive} -setup { @@ -161,6 +175,8 @@ test nre-5.2 {[namespace eval] is not recursive} -setup { foo::a 0 } -cleanup { namespace delete ::foo +} -constraints { + testnrelevels } -result {{0 2 2 2} 0} test nre-6.1 {[uplevel] is not recursive} -setup { @@ -171,6 +187,8 @@ test nre-6.1 {[uplevel] is not recursive} -setup { } -cleanup { rename a {} unset abs +} -constraints { + testnrelevels } -result {{0 2 2 0} 0} test nre-6.2 {[uplevel] is not recursive} -setup { @@ -181,6 +199,8 @@ test nre-6.2 {[uplevel] is not recursive} -setup { } -cleanup { rename a {} unset abs +} -constraints { + testnrelevels } -result {{0 2 2 0} 0} test nre-7.1 {[catch] is not recursive} -setup { @@ -191,6 +211,8 @@ test nre-7.1 {[catch] is not recursive} -setup { } -cleanup { rename a {} unset abs +} -constraints { + testnrelevels } -result {{0 3 3 0} 0} test nre-7.2 {[if] is not recursive} -setup { @@ -201,6 +223,8 @@ test nre-7.2 {[if] is not recursive} -setup { } -cleanup { rename a {} unset abs +} -constraints { + testnrelevels } -result {{0 2 2 0} 0} test nre-7.3 {[while] is not recursive} -setup { @@ -211,6 +235,8 @@ test nre-7.3 {[while] is not recursive} -setup { } -cleanup { rename a {} unset abs +} -constraints { + testnrelevels } -result {{0 2 2 0} 0} test nre-7.4 {[for] is not recursive} -setup { @@ -221,6 +247,8 @@ test nre-7.4 {[for] is not recursive} -setup { } -cleanup { rename a {} unset abs +} -constraints { + testnrelevels } -result {{0 2 2 0} 0} test nre-7.5 {[foreach] is not recursive} -constraints {knownBug} -setup { @@ -234,7 +262,9 @@ test nre-7.5 {[foreach] is not recursive} -constraints {knownBug} -setup { } -cleanup { rename a {} unset abs -} -result {{0 2 2 0} 0} +} -constraints { + testnrelevels +} -result {{0 3 3 0} 0} test nre-7.6 {[eval] is not recursive} -setup { proc a i [makebody {eval [list a $i]}] @@ -244,6 +274,8 @@ test nre-7.6 {[eval] is not recursive} -setup { } -cleanup { rename a {} unset abs +} -constraints { + testnrelevels } -result {{0 2 2 1} 0} test nre-7.7 {[eval] is not recursive} -setup { @@ -254,6 +286,8 @@ test nre-7.7 {[eval] is not recursive} -setup { } -cleanup { rename a {} unset abs +} -constraints { + testnrelevels } -result {{0 2 2 1} 0} test nre-8.1 {nre and {*}} -body { @@ -285,6 +319,8 @@ test nre-oo.1 {really deep calls in oo - direct} -setup { } -cleanup { foo destroy unset abs +} -constraints { + testnrelevels } -result {{0 1 1 1} 0} test nre-oo.2 {really deep calls in oo - call via [self]} -setup { @@ -296,6 +332,8 @@ test nre-oo.2 {really deep calls in oo - call via [self]} -setup { } -cleanup { foo destroy unset abs +} -constraints { + testnrelevels } -result {{0 1 1 1} 0} test nre-oo.3 {really deep calls in oo - private calls} -setup { @@ -307,6 +345,8 @@ test nre-oo.3 {really deep calls in oo - private calls} -setup { } -cleanup { foo destroy unset abs +} -constraints { + testnrelevels } -result {{0 1 1 1} 0} test nre-oo.4 {really deep calls in oo - overriding} -setup { @@ -323,6 +363,8 @@ test nre-oo.4 {really deep calls in oo - overriding} -setup { } -cleanup { foo destroy unset abs +} -constraints { + testnrelevels } -result {{0 1 1 1} 0} test nre-oo.5 {really deep calls in oo - forwards} -setup { @@ -338,6 +380,8 @@ test nre-oo.5 {really deep calls in oo - forwards} -setup { } -cleanup { foo destroy unset abs +} -constraints { + testnrelevels } -result {{0 2 1 1} 0} @@ -362,7 +406,6 @@ test nre-X.1 {eval in wrong interp} { set res } {::foo ::foo {} {}} - # cleanup ::tcltest::cleanupTests -- cgit v0.12