diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclListObj.c | 27 | ||||
| -rw-r--r-- | tests/lset.test | 6 |
3 files changed, 36 insertions, 6 deletions
@@ -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 |