From 151836cea1737631c005e07ca9a26e7641ff009d Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Thu, 28 Oct 2004 17:21:18 +0000
Subject: fix for execution stack	corruption [Bug 1055676]. Credit dgp
 for detective work and fix.

---
 ChangeLog            |  6 ++++++
 generic/tclExecute.c |  4 +++-
 tests/execute.test   | 24 +++++++++++++++++++++++-
 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
-- 
cgit v0.12