diff options
| author | Miguel Sofer <miguel.sofer@gmail.com> | 2004-10-28 17:21:18 (GMT) |
|---|---|---|
| committer | Miguel Sofer <miguel.sofer@gmail.com> | 2004-10-28 17:21:18 (GMT) |
| commit | 151836cea1737631c005e07ca9a26e7641ff009d (patch) | |
| tree | 090220d9e325f851fb03102f9a4042735591871d | |
| parent | 56606ac70dec0e61009ec6ef2da57193abc0c33b (diff) | |
| download | tcl-151836cea1737631c005e07ca9a26e7641ff009d.zip tcl-151836cea1737631c005e07ca9a26e7641ff009d.tar.gz tcl-151836cea1737631c005e07ca9a26e7641ff009d.tar.bz2 | |
fix for execution stack corruption [Bug 1055676]. Credit dgp for detective
work and fix.
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclExecute.c | 4 | ||||
| -rw-r--r-- | tests/execute.test | 24 |
3 files changed, 32 insertions, 2 deletions
@@ -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 |