summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclExecute.c4
-rw-r--r--tests/execute.test24
3 files changed, 32 insertions, 2 deletions
diff --git a/ChangeLog b/ChangeLog
index f163d18..4421e8d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2004-10-28 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (INST_START_CMD):
+ * tests/execute.test (execute-8.3): fix for execution stack
+ corruption [Bug 1055676]. Credit dgp for detective work and fix.
+
2004-10-27 Don Porter <dgp@users.sourceforge.net>
* tests/socket.test (socket-13.1): Balanced [makeFile] and
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 4c5c7d9..b5d24cd 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,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.162 2004/10/25 20:24:12 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.163 2004/10/28 17:21:23 msofer Exp $
*/
#ifdef STDC_HEADERS
@@ -1317,7 +1317,9 @@ TclExecuteByteCode(interp, codePtr)
Tcl_Obj *newObjResultPtr;
bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ DECACHE_STACK_INFO();
result = Tcl_EvalEx(interp, bytes, length, 0);
+ CACHE_STACK_INFO();
if (result != TCL_OK) {
cleanup = 0;
goto processExceptionReturn;
diff --git a/tests/execute.test b/tests/execute.test
index 9075b28..0f02e01 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -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: execute.test,v 1.18 2004/05/25 17:17:38 dgp Exp $
+# RCS: @(#) $Id: execute.test,v 1.19 2004/10/28 17:21:25 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -739,6 +739,28 @@ test execute-8.2 {Stack restoration} -body {
interp recursionlimit {} $limit
} -result {too many nested evaluations (infinite loop?)}
+test execute-8.3 {Stack restoration} -body {
+ # Test for [Bug #1055676], correct restoration
+ # of the stack top after the epoch is bumped and
+ # the stack is grown in a call from a nested evaluation
+ set arglst [string repeat "a " 1000]
+ proc f {args} "f $arglst"
+ proc run {} {
+ # bump the interp's epoch
+ rename ::set ::dummy
+ rename ::dummy ::set
+ catch f msg
+ set msg
+ }
+ run
+ } -setup {
+ # Avoid crashes when system stack size is limited (thread-enabled!)
+ set limit [interp recursionlimit {}]
+ interp recursionlimit {} 100
+ } -cleanup {
+ interp recursionlimit {} $limit
+ } -result {too many nested evaluations (infinite loop?)}
+
# cleanup
if {[info commands testobj] != {}} {
testobj freeallvars