* 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].

4 files changed, 31 insertions, 7 deletions

diff --git a/ChangeLog b/ChangeLog
index de8d594..58e412b 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-06-10  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclStringObj.c:	Revised [format] to not overflow the
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 3c7ca6e..c7b311b 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.146.2.6 2008/07/25 20:30:44 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.146.2.7 2009/06/13 14:25:12 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -870,6 +870,7 @@ TclInitCompileEnv(
     envPtr->source = stringPtr;
     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 9313154..717b8bc 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -12,7 +12,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.139.2.4 2008/10/19 19:54:22 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.139.2.5 2009/06/13 14:25:13 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1891,7 +1891,6 @@ ProcCompileProc(
     Interp *iPtr = (Interp *) interp;
     int i;
     Tcl_CallFrame *framePtr;
-    Proc *saveProcPtr;
     ByteCode *codePtr = bodyPtr->internalRep.otherValuePtr;
     CompiledLocal *localPtr;
 
@@ -1961,8 +1960,6 @@ ProcCompileProc(
  	 *   appropriate class context.
  	 */
 
- 	saveProcPtr = iPtr->compiledProcPtr;
-
 	if (procPtrPtr != NULL && procPtr->refCount > 1) {
 	    Tcl_Command token;
 	    Tcl_CmdInfo info;
@@ -2045,7 +2042,6 @@ ProcCompileProc(
 	(void) tclByteCodeType.setFromAnyProc(interp, bodyPtr);
 	iPtr->invokeCmdFramePtr = NULL;
 	TclPopStackFrame(interp);
- 	iPtr->compiledProcPtr = saveProcPtr;
     } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
 	/*
 	 * The resolver epoch has changed, but we only need to invalidate the
diff --git a/tests/execute.test b/tests/execute.test
index 51d375e..5f3ccf5 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.27.2.1 2008/08/04 04:48:16 dgp Exp $
+# RCS: @(#) $Id: execute.test,v 1.27.2.2 2009/06/13 14:25:13 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -972,6 +972,19 @@ test execute-9.1 {Interp result resetting [Bug 1522803]} {
     set result
 } SUCCESS
 
+test execute-10.1 {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