From 6f2e8c77532df55d185274fbc12464f5f539d08e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 6 Oct 2010 18:38:43 +0000
Subject:         * generic/tclCompile.c: Prevent writing to the intrep fields
 of a         * tests/subst.test:     freed Tcl_Obj.  [Bug 3081065]

---
 ChangeLog            |  5 +++++
 generic/tclCompile.c |  6 +++---
 tests/subst.test     | 26 +++++++++++++++++++++++++-
 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
-- 
cgit v0.12