summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2009-06-13 14:38:44 (GMT)
committerdgp <dgp@users.sourceforge.net>2009-06-13 14:38:44 (GMT)
commit75857eb1811ac33b4d22fe4dc0949b9975a005a8 (patch)
treeba2f380d72e881d52e3720c24fccf6aad4eb80c3
parent04ea78ea6abac1b67cda877f32c8a79a0496b44b (diff)
downloadtcl-75857eb1811ac33b4d22fe4dc0949b9975a005a8.zip
tcl-75857eb1811ac33b4d22fe4dc0949b9975a005a8.tar.gz
tcl-75857eb1811ac33b4d22fe4dc0949b9975a005a8.tar.bz2
* generic/tclCompile.c: The value stashed in iPtr->compiledProcPtr
* generic/tclProc.c: when compiling a proc survives too long. We * tests/execute.test: only need it there long enough for the right TclInitCompileEnv() call to re-stash it into envPtr->procPtr. Once that is done, the CompileEnv controls. If we let the value of iPtr->compiledProcPtr linger, though, then any other bytecode compile operation that takes place will also have its CompileEnv initialized with it, and that's not correct. The value is meant to control the compile of the proc body only, not other compile tasks that happen along. Thanks to Carlos Tasada for discovering and reporting the problem. [Bug 2802881].
-rw-r--r--ChangeLog14
-rw-r--r--generic/tclCompile.c3
-rw-r--r--generic/tclProc.c7
-rw-r--r--tests/execute.test15
4 files changed, 31 insertions, 8 deletions
diff --git a/ChangeLog b/ChangeLog
index 07dc8bb..ad05f98 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2009-06-13 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclCompile.c: The value stashed in iPtr->compiledProcPtr
+ * generic/tclProc.c: when compiling a proc survives too long. We
+ * tests/execute.test: only need it there long enough for the right
+ TclInitCompileEnv() call to re-stash it into envPtr->procPtr. Once
+ that is done, the CompileEnv controls. If we let the value of
+ iPtr->compiledProcPtr linger, though, then any other bytecode compile
+ operation that takes place will also have its CompileEnv initialized
+ with it, and that's not correct. The value is meant to control the
+ compile of the proc body only, not other compile tasks that happen
+ along. Thanks to Carlos Tasada for discovering and reporting the
+ problem. [Bug 2802881].
+
2009-04-28 Jeff Hobbs <jeffh@ActiveState.com>
* unix/tcl.m4, unix/configure (SC_CONFIG_CFLAGS): harden the check
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 44ee69b..98ccc50 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.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: tclCompile.c,v 1.43.2.13 2008/07/28 20:01:09 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.43.2.14 2009/06/13 14:38:44 dgp Exp $
*/
#include "tclInt.h"
@@ -773,6 +773,7 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
envPtr->source = string;
envPtr->numSrcBytes = numBytes;
envPtr->procPtr = iPtr->compiledProcPtr;
+ iPtr->compiledProcPtr = NULL;
envPtr->numCommands = 0;
envPtr->exceptDepth = 0;
envPtr->maxExceptDepth = 0;
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 950d448..1e9f6b4 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.44.2.9 2008/08/11 20:13:43 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.44.2.10 2009/06/13 14:38:44 dgp Exp $
*/
#include "tclInt.h"
@@ -1300,7 +1300,6 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
Interp *iPtr = (Interp*)interp;
int i, result;
Tcl_CallFrame frame;
- Proc *saveProcPtr;
ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
CompiledLocal *localPtr;
@@ -1369,8 +1368,6 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
* compiled in the appropriate class context.
*/
- saveProcPtr = iPtr->compiledProcPtr;
-
if (procPtrPtr != NULL && procPtr->refCount > 1) {
Tcl_Command token;
Tcl_CmdInfo info;
@@ -1455,8 +1452,6 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
Tcl_PopCallFrame(interp);
}
- iPtr->compiledProcPtr = saveProcPtr;
-
if (result != TCL_OK) {
if (result == TCL_ERROR) {
char buf[100 + TCL_INTEGER_SPACE];
diff --git a/tests/execute.test b/tests/execute.test
index 47ac562..e0adda7 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.13.2.4 2008/03/07 20:26:22 dgp Exp $
+# RCS: @(#) $Id: execute.test,v 1.13.2.5 2009/06/13 14:38:44 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -904,6 +904,19 @@ test execute-8.1 {Stack protection} -setup {
rename whatever {}
} -returnCodes error -match glob -result *
+test execute-10.2 {Bug 2802881} -setup {
+ interp create slave
+} -body {
+ # If [Bug 2802881] is not fixed, this will segfault
+ slave eval {
+ trace add variable ::errorInfo write {expr {$foo} ;#}
+ proc demo {} {a {}{}}
+ demo
+ }
+} -cleanup {
+ interp delete slave
+} -returnCodes error -match glob -result *
+
# cleanup
if {[info commands testobj] != {}} {
testobj freeallvars