* generic/tclListObj.c (TclLsetFlat):

	* tests/lset.test (lset-10.3): fixed handling of unshared lists
	with shared sublists, [Bug 1333036] reported by neuronstorm.

3 files changed, 36 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index 9a790af..c8aff1e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2005-10-20  Miguel Sofer <msofer@users.sf.net>
+
+	* generic/tclListObj.c (TclLsetFlat):
+	* tests/lset.test (lset-10.3): fixed handling of unshared lists
+	with shared sublists, [Bug 1333036] reported by neuronstorm. 
+	
 2005-10-19  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclIORChan.c (PassReceivedError,PassReceivedErrorInterp):
@@ -28,7 +34,8 @@
 2005-10-19  Miguel Sofer <msofer@users.sf.net>
 
 	* generic/tclExecute.c (INST_DICT_APPEND, INST_DICT_LAPPEND): fixed
-	faulty peephole optimisation that can cause crashes [Bug 1331475]
+	faulty peephole optimisation that can cause crashes, [Bug 1331475]
+	reported by Aric Bills.
 
 2005-10-18  Don Porter  <dgp@users.sourceforge.net>
 
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index e83a8f4..2c5c4d4 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclListObj.c,v 1.27 2005/09/06 14:40:11 dkf Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.28 2005/10/20 12:21:44 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1112,12 +1112,21 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr)
     }
 
     /*
-     * If the list is shared, make a private copy.
+     * If the list is shared, make a private copy. Duplicate the intrep to
+     * insure that it is modifyable [Bug 1333036]. A plain Tcl_DuplicateObj
+     * will just increase the intrep's refCount without upping the sublists'
+     * refCount, so that their true shared status cannot be determined from
+     * their refCount. 
      */
 
     if (Tcl_IsShared(listPtr)) {
 	duplicated = 1;
-	listPtr = Tcl_DuplicateObj(listPtr);
+	if (listPtr->typePtr == &tclListType) {	
+	    result = Tcl_ListObjGetElements(interp, listPtr, &elemCount, &elemPtrs);
+	    listPtr = Tcl_NewListObj(elemCount, elemPtrs);
+	} else {
+	    listPtr = Tcl_DuplicateObj(listPtr);
+	}
 	Tcl_IncrRefCount(listPtr);
     } else {
 	duplicated = 0;
@@ -1182,12 +1191,20 @@ TclLsetFlat(interp, listPtr, indexCount, indexArray, valuePtr)
 	}
 
 	/*
-	 * Extract the appropriate sublist, and make sure that it is unshared.
+	 * Extract the appropriate sublist, and make sure that it is unshared. 
+	 * If it is a list, duplicate the intrep to avoid [Bug 1333036], as
+	 * per the previous comment. 
 	 */
 
 	subListPtr = elemPtrs[index];
 	if (Tcl_IsShared(subListPtr)) {
-	    subListPtr = Tcl_DuplicateObj(subListPtr);
+	    if (subListPtr->typePtr == &tclListType) {
+		result = Tcl_ListObjGetElements(interp, subListPtr, &elemCount,
+			&elemPtrs);
+		subListPtr = Tcl_NewListObj(elemCount, elemPtrs);
+	    } else {
+		subListPtr = Tcl_DuplicateObj(subListPtr);
+	    }
 	    result = TclListObjSetElement(interp, listPtr, index, subListPtr);
 	    if (result != TCL_OK) {
 		/*
diff --git a/tests/lset.test b/tests/lset.test
index 00facb2..e122f48 100644
--- a/tests/lset.test
+++ b/tests/lset.test
@@ -369,6 +369,12 @@ test lset-10.2 {lset, not compiled, shared data} testevalex {
     list [testevalex {lset a {0 0} x}] $a
 } {{{x q} {p q}} {{x q} {p q}}}
 
+test lset-10.3 {lset, not compiled, shared data, [Bug 1333036]} testevalex {
+    set a [list [list p q] [list r s]]
+    set b $a
+    list [testevalex {lset b {0 0} x}] $a
+} {{{x q} {r s}} {{p q} {r s}}}
+
 test lset-11.1 {lset, not compiled, 2-d basics} testevalex {
     set a {{b c} {d e}}
     list [testevalex {lset a 0 0 f}] $a