diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclCompile.c | 6 | ||||
| -rw-r--r-- | tests/subst.test | 26 |
3 files changed, 33 insertions, 4 deletions
@@ -1,3 +1,8 @@ +2010-10-06 Don Porter <dgp@users.sourceforge.net> + + * generic/tclCompile.c: Prevent writing to the intrep fields of a + * tests/subst.test: freed Tcl_Obj. [Bug 3081065] + 2010-10-02 Donal K. Fellows <dkf@users.sf.net> * generic/tclExecute.c (TEBCresume): [Bug 3079830]: Added invalidation diff --git a/generic/tclCompile.c b/generic/tclCompile.c index a34966d..b250420 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.188 2010/09/27 19:42:38 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.189 2010/10/06 18:38:44 dgp Exp $ */ #include "tclInt.h" @@ -1050,12 +1050,12 @@ FreeSubstCodeInternalRep( { register ByteCode *codePtr = objPtr->internalRep.ptrAndLongRep.ptr; + objPtr->typePtr = NULL; + objPtr->internalRep.otherValuePtr = NULL; codePtr->refCount--; if (codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); } - objPtr->typePtr = NULL; - objPtr->internalRep.otherValuePtr = NULL; } /* diff --git a/tests/subst.test b/tests/subst.test index 1b9ccf6..0c81069 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -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: subst.test,v 1.20 2010/04/08 13:26:25 dkf Exp $ +# RCS: @(#) $Id: subst.test,v 1.21 2010/10/06 18:38:45 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -271,6 +271,30 @@ test subst-12.7 {nasty case with compilation} { set y unset list [eval [list subst {[set x 1;continue;incr x][set y $x]}]] $x $y } {1 1 1} + +test subst-13.1 {Bug 3081065} -setup { + set script [makeFile { + proc demo {string} { + subst $string + } + demo name2 + } subst13.tcl] +} -body { + interp create slave + slave eval [list source $script] + interp delete slave + interp create slave + slave eval { + set count 400 + while {[incr count -1]} { + lappend bloat [expr {rand()}] + } + } + slave eval [list source $script] + interp delete slave +} -cleanup { + removeFile subst13.tcl +} # cleanup ::tcltest::cleanupTests |