summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2010-10-06 18:38:43 (GMT)
committerdgp <dgp@users.sourceforge.net>2010-10-06 18:38:43 (GMT)
commit6f2e8c77532df55d185274fbc12464f5f539d08e (patch)
treea9dd047e09a12188519488e348aca5875b396335
parent5e88dcc48d62ffa8d6a6cb309bf9640936629494 (diff)
downloadtcl-6f2e8c77532df55d185274fbc12464f5f539d08e.zip
tcl-6f2e8c77532df55d185274fbc12464f5f539d08e.tar.gz
tcl-6f2e8c77532df55d185274fbc12464f5f539d08e.tar.bz2
* generic/tclCompile.c: Prevent writing to the intrep fields of a
* tests/subst.test: freed Tcl_Obj. [Bug 3081065]
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclCompile.c6
-rw-r--r--tests/subst.test26
3 files changed, 33 insertions, 4 deletions
diff --git a/ChangeLog b/ChangeLog
index 2dabe2f..adee8dd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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