Index: generic/tclDictObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDictObj.c,v
retrieving revision 1.12
diff -u -r1.12 tclDictObj.c
--- generic/tclDictObj.c	24 Dec 2003 04:18:19 -0000	1.12
+++ generic/tclDictObj.c	13 Jan 2004 23:53:49 -0000
@@ -373,6 +373,15 @@
 	}
 
 	/*
+	 * If the list is shared its string rep must not be lost so it
+	 * still is the same list.
+	 */
+
+	if (Tcl_IsShared(objPtr)) {
+	    Tcl_GetString(objPtr);
+	}
+
+	/*
 	 * Build the hash of key/value pairs.
 	 */
 	dict = (Dict *) ckalloc(sizeof(Dict));
@@ -594,6 +603,7 @@
 	    if (Tcl_IsShared(tmpObj)) {
 		Tcl_DecrRefCount(tmpObj);
 		tmpObj = Tcl_DuplicateObj(tmpObj);
+		Tcl_IncrRefCount(tmpObj);
 		Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
 		dict->epoch++;
 		newDict = (Dict *) tmpObj->internalRep.otherValuePtr;
@@ -1355,6 +1365,7 @@
 {
     Tcl_Obj *dictPtr;
     int i, result;
+    int allocatedDict = 0;
 
     if ((objc < 3) || !(objc & 1)) {
 	Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key value ...?");
@@ -1364,10 +1375,14 @@
     dictPtr = objv[2];
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
+	allocatedDict = 1;
     }
     for (i=3 ; i<objc ; i+=2) {
 	result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
 	if (result != TCL_OK) {
+	    if (allocatedDict) {
+		Tcl_DecrRefCount(dictPtr);
+	    }
 	    return TCL_ERROR;
 	}
     }
@@ -1401,6 +1416,7 @@
 {
     Tcl_Obj *dictPtr;
     int i, result;
+    int allocatedDict = 0;
 
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key ...?");
@@ -1410,10 +1426,14 @@
     dictPtr = objv[2];
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
+	allocatedDict = 1;
     }
     for (i=3 ; i<objc ; i++) {
 	result = Tcl_DictObjRemove(interp, dictPtr, objv[i]);
 	if (result != TCL_OK) {
+	    if (allocatedDict) {
+		Tcl_DecrRefCount(dictPtr);
+	    }
 	    return TCL_ERROR;
 	}
     }
@@ -1685,6 +1705,7 @@
     int result, isWide = 0;
     long incrValue = 1;
     Tcl_WideInt wideIncrValue = 0;
+    int allocatedDict = 0;
 
     if (objc < 4 || objc > 5) {
 	Tcl_WrongNumArgs(interp, 2, objv, "varName key ?increment?");
@@ -1714,6 +1735,7 @@
 
     dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
     if (dictPtr == NULL) {
+	allocatedDict = 1;
 	dictPtr = Tcl_NewDictObj();
 	if (isWide) {
 	    valuePtr = Tcl_NewWideIntObj(wideIncrValue);
@@ -1726,10 +1748,14 @@
 	Tcl_WideInt wValue;
 
 	if (Tcl_IsShared(dictPtr)) {
+	    allocatedDict = 1;
 	    dictPtr = Tcl_DuplicateObj(dictPtr);
 	}
 
 	if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) {
+	    if (allocatedDict) {
+		Tcl_DecrRefCount(dictPtr);
+	    }
 	    return TCL_ERROR;
 	}
 	if (valuePtr == NULL) {
@@ -1785,6 +1811,9 @@
 	     */
 	    result = Tcl_GetWideIntFromObj(interp, valuePtr, &wValue);
 	    if (result != TCL_OK) {
+		if (allocatedDict) {
+		    Tcl_DecrRefCount(dictPtr);
+		}
 		return result;
 	    }
 	    /*
@@ -1818,15 +1847,23 @@
 	    }
 	}
 	if (Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr) != TCL_OK) {
+	    /* 
+	     * This shouldn't happen since dictPtr is known
+	     * from above to be a valid dictionary.
+	     */
+	    if (allocatedDict) {
+		Tcl_DecrRefCount(dictPtr);
+	    }
 	    Tcl_DecrRefCount(valuePtr);
 	    return TCL_ERROR;
 	}
     }
   valueAlreadyInDictionary:
+    Tcl_IncrRefCount(dictPtr);
     resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
+    Tcl_DecrRefCount(dictPtr);
     if (resultPtr == NULL) {
-	Tcl_DecrRefCount(dictPtr);
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, resultPtr);
@@ -1910,12 +1947,11 @@
 	Tcl_InvalidateStringRep(dictPtr);
     }
 
+    Tcl_IncrRefCount(dictPtr);
     resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
+    Tcl_DecrRefCount(dictPtr);
     if (resultPtr == NULL) {
-	if (allocatedDict) {
-	    Tcl_DecrRefCount(dictPtr);
-	}
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, resultPtr);
@@ -1984,12 +2020,11 @@
 
     Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr);
 
+    Tcl_IncrRefCount(dictPtr);
     resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
+    Tcl_DecrRefCount(dictPtr);
     if (resultPtr == NULL) {
-	if (allocatedDict) {
-	    Tcl_DecrRefCount(dictPtr);
-	}
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, resultPtr);
@@ -2188,12 +2223,11 @@
 	return TCL_ERROR;
     }
 
+    Tcl_IncrRefCount(dictPtr);
     resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
+    Tcl_DecrRefCount(dictPtr);
     if (resultPtr == NULL) {
-	if (allocatedDict) {
-	    Tcl_DecrRefCount(dictPtr);
-	}
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, resultPtr);
@@ -2249,12 +2283,11 @@
 	return TCL_ERROR;
     }
 
+    Tcl_IncrRefCount(dictPtr);
     resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
+    Tcl_DecrRefCount(dictPtr);
     if (resultPtr == NULL) {
-	if (allocatedDict) {
-	    Tcl_DecrRefCount(dictPtr);
-	}
 	return TCL_ERROR;
     }
     Tcl_SetObjResult(interp, resultPtr);
Index: tests/dict.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/dict.test,v
retrieving revision 1.4
diff -u -r1.4 dict.test
--- tests/dict.test	6 Oct 2003 14:32:22 -0000	1.4
+++ tests/dict.test	13 Jan 2004 23:53:49 -0000
@@ -136,6 +136,7 @@
     list [catch {dict replace [list a a a] a b} msg] $msg
 } {1 {missing value to go with key}}
 test dict-4.9 {dict replace command} {dict replace [list a a] a b} {a b}
+test dict-4.10 {dict replace command} {dict replace [list a a] a b a c} {a c}
 
 test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d}
 test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}
@@ -711,6 +712,158 @@
     list [catch {dict filter a key *} msg] $msg
 } {1 {missing value to go with key}}
 
+test dict-18.1 {dict-list relationship} {
+    -body {
+        # Test that any internal conversion between list and dict
+        # does not change the object
+        set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y]
+        dict values $l
+        set l
+    }
+    -result {1 2 3 4 5 6 7 8 9 0 q w e r t y}
+}
+test dict-18.2 {dict-list relationship} {
+    -body {
+        # Test that the dictionary is a valid list
+        set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2]
+        for {set t 0} {$t < 5} {incr t} {
+            llength $d
+            dict lappend d "abc def" "\}\{"
+            dict append  d "a\{b" "\}"
+            dict incr    d "c\}d" 1
+        }
+        llength $d
+    }
+    -result 6
+}
+
+# This is a test for a specific bug.
+# It shows a bad ref counter when running with memdebug on.
+test dict-19.1 {memory bug} -setup {
+    proc xxx {} {
+        set successors [dict create x {c d}]
+        dict set successors x a b
+        dict get $successors x
+    }
+} -body {
+    xxx
+} -cleanup {
+    rename xxx {}
+} -result [dict create c d a b]
+
+testConstraint memory [llength [info commands memory]]
+test dict-19.2 {dict: testing for leaks} -setup {
+    proc getbytes {} {
+        set lines [split [memory info] "\n"]
+        lindex [lindex $lines 3] 3
+    }
+    # This test is made to stress object reference management
+    proc stress {} {
+        # A shared invalid dictinary
+        set apa {a {}b c d}
+        set bepa $apa
+        catch {dict replace $apa e f}
+        catch {dict remove  $apa c d}
+        catch {dict incr    apa  a 5}
+        catch {dict lappend apa  a 5}
+        catch {dict append  apa  a 5}
+        catch {dict set     apa  a 5}
+        catch {dict unset   apa  a}
+
+        # A shared valid dictionary, invalid incr
+        set apa {a b c d}
+        set bepa $apa
+        catch {dict incr bepa a 5}
+
+        # An error during write to an unshared object, incr
+        set apa {a 1 b 2}
+        set bepa [lrange $apa 0 end]
+        trace add variable bepa write {error hej}
+        catch {dict incr bepa a 5}
+        unset bepa
+
+        # An error during write to a shared object, incr
+        set apa {a 1 b 2}
+        set bepa $apa
+        trace add variable bepa write {error hej}
+        catch {dict incr bepa a 5}
+        unset bepa
+
+        # A shared valid dictionary, invalid lappend
+        set apa [list a {{}b} c d]
+        set bepa $apa
+        catch {dict lappend bepa a 5}
+
+        # An error during write to an unshared object, lappend
+        set apa {a 1 b 2}
+        set bepa [lrange $apa 0 end]
+        trace add variable bepa write {error hej}
+        catch {dict lappend bepa a 5}
+        unset bepa
+
+        # An error during write to a shared object, lappend
+        set apa {a 1 b 2}
+        set bepa $apa
+        trace add variable bepa write {error hej}
+        catch {dict lappend bepa a 5}
+        unset bepa
+
+        # An error during write to an unshared object, append
+        set apa {a 1 b 2}
+        set bepa [lrange $apa 0 end]
+        trace add variable bepa write {error hej}
+        catch {dict append bepa a 5}
+        unset bepa
+
+        # An error during write to a shared object, append
+        set apa {a 1 b 2}
+        set bepa $apa
+        trace add variable bepa write {error hej}
+        catch {dict append bepa a 5}
+        unset bepa
+
+        # An error during write to an unshared object, set
+        set apa {a 1 b 2}
+        set bepa [lrange $apa 0 end]
+        trace add variable bepa write {error hej}
+        catch {dict set bepa a 5}
+        unset bepa
+
+        # An error during write to a shared object, set
+        set apa {a 1 b 2}
+        set bepa $apa
+        trace add variable bepa write {error hej}
+        catch {dict set bepa a 5}
+        unset bepa
+
+        # An error during write to an unshared object, unset
+        set apa {a 1 b 2}
+        set bepa [lrange $apa 0 end]
+        trace add variable bepa write {error hej}
+        catch {dict unset bepa a}
+        unset bepa
+
+        # An error during write to a shared object, unset
+        set apa {a 1 b 2}
+        set bepa $apa
+        trace add variable bepa write {error hej}
+        catch {dict unset bepa a}
+        unset bepa
+    }
+} -constraints memory -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+        stress
+        set tmp $end
+        set end [getbytes]
+    }    
+    set leak [expr {$end - $tmp}]
+} -cleanup {
+    unset -nocomplain end i tmp
+    rename getbytes {}
+    rename stress {}
+} -result 0
+    
 # cleanup
 ::tcltest::cleanupTests
 return
