summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog10
-rw-r--r--generic/tclBasic.c5
-rw-r--r--generic/tclCompile.h3
-rw-r--r--generic/tclExecute.c9
-rw-r--r--tests/nre.test49
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 <msofer@users.sf.net>
+
+ * 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 <dkf@users.sf.net>
* 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
generated by cgit v0.12 at 2024-07-05 14:33:08 (GMT)