From fdb97a3d7dd85152f33c8232bc038c32e995f8af Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 13 Jun 2009 14:31:54 +0000 Subject: * 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]. --- ChangeLog | 14 ++++++++++++++ generic/tclCompile.c | 3 ++- generic/tclProc.c | 5 +---- tests/execute.test | 15 ++++++++++++++- 4 files changed, 31 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index d3462ad..3e744c2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2009-06-13 Don Porter + + * 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 * generic/tclStringObj.c: Revised [format] to not overflow the diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 63a95aa..14ed9a0 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.166 2009/02/09 22:55:44 nijtmans Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.167 2009/06/13 14:31:54 dgp Exp $ */ #include "tclInt.h" @@ -868,6 +868,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 2062672..7696015 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.171 2009/03/24 09:30:07 dkf Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.172 2009/06/13 14:31:54 dgp Exp $ */ #include "tclInt.h" @@ -1939,7 +1939,6 @@ TclProcCompileProc( { Interp *iPtr = (Interp *) interp; Tcl_CallFrame *framePtr; - Proc *saveProcPtr; ByteCode *codePtr = bodyPtr->internalRep.otherValuePtr; /* @@ -2009,7 +2008,6 @@ TclProcCompileProc( * appropriate class context. */ - saveProcPtr = iPtr->compiledProcPtr; iPtr->compiledProcPtr = procPtr; if (procPtr->numCompiledLocals > procPtr->numArgs) { @@ -2055,7 +2053,6 @@ TclProcCompileProc( 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 f6174d0..fad153b 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.30 2009/02/05 14:21:43 dkf Exp $ +# RCS: @(#) $Id: execute.test,v 1.31 2009/06/13 14:31:54 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -979,6 +979,19 @@ test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} { apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} \u0130 } {48 {304 304}} +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 -- cgit v0.12