From 83ab078e4e7530981a3602ee33c4494746f88bd5 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 12 Sep 2017 17:01:55 +0000
Subject: Rework [lset] internals to be sure outdated intreps get purged.

---
 generic/tclListObj.c | 39 ++++++++++++++++++++++++++++++---------
 1 file changed, 30 insertions(+), 9 deletions(-)

diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index f60329d..c6d8d0e 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1594,23 +1594,32 @@ TclLsetFlat(
 
     while (chainPtr) {
 	Tcl_Obj *objPtr = chainPtr;
+	List *listRepPtr;
 
+	/*
+	 * Clear away our intrep surgery mess.
+	 */
+
+	irPtr = Tcl_FetchIntRep(objPtr, &tclListType);
+	listRepPtr = irPtr->twoPtrValue.ptr1;
+	chainPtr = irPtr->twoPtrValue.ptr2;
+	
 	if (result == TCL_OK) {
+
 	    /*
 	     * We're going to store valuePtr, so spoil string reps of all
 	     * containing lists.
 	     */
 
+	    listRepPtr->refCount++;
+	    TclFreeIntRep(objPtr);
+	    ListSetIntRep(objPtr, listRepPtr);
+	    listRepPtr->refCount--;
+
 	    TclInvalidateStringRep(objPtr);
+	} else {
+	    irPtr->twoPtrValue.ptr2 = NULL;
 	}
-
-	/*
-	 * Clear away our intrep surgery mess.
-	 */
-
-	irPtr = Tcl_FetchIntRep(objPtr, &tclListType);
-	chainPtr = irPtr->twoPtrValue.ptr2;
-	irPtr->twoPtrValue.ptr2 = NULL;
     }
 
     if (result != TCL_OK) {
@@ -1637,8 +1646,8 @@ TclLsetFlat(
 	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
     } else {
 	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+	TclInvalidateStringRep(subListPtr);
     }
-    TclInvalidateStringRep(subListPtr);
     Tcl_IncrRefCount(retValuePtr);
     return retValuePtr;
 }
@@ -1781,6 +1790,18 @@ TclListObjSetElement(
 
     elemPtrs[index] = valuePtr;
 
+    /*
+     * Invalidate outdated intreps.
+     */
+
+    ListGetIntRep(listPtr, listRepPtr);
+    listRepPtr->refCount++;
+    TclFreeIntRep(listPtr);
+    ListSetIntRep(listPtr, listRepPtr);
+    listRepPtr->refCount--;
+
+    TclInvalidateStringRep(listPtr);
+
     return TCL_OK;
 }
 
-- 
cgit v0.12