Fixed bugs 715751 and 713562 so dict code should build everywhere and wide ints

be defined (though not necessarily useful) everywhere.

4 files changed, 64 insertions, 27 deletions

diff --git a/ChangeLog b/ChangeLog
index b643b60..c9098b7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2003-04-07  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* tests/dict.test (dict-2.6): 
+	* generic/tclDictObj.c (Tcl_NewDictObj, Tcl_DbNewDictObj): Oops!
+	Failed to fully initialise the Dict structure.
+	(DictIncrCmd): Moved valueAlreadyInDictionary label to stop
+	compiler complaints.  [Bug 715751]
+
+	* generic/tclDictObj.c (DictIncrCmd): Followed style in the rest of
+	the core by commenting out wide-specific operations on platforms
+	where wides are longs, and used longs more thoroughly than ints
+	through [dict incr] anyway to forestall further bugs.
+	* generic/tclObj.c: Made sure there's always a tclWideIntType
+	implementation available, not that it is always useful.  [Bug 713562]
+
 2003-04-05  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
 	* generic/tclDictObj.c: Removed commented out notes on
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index b4c1225..ee8d5c4 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDictObj.c,v 1.3 2003/04/05 07:32:32 dgp Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.4 2003/04/07 10:12:09 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -185,7 +185,7 @@ FreeDictInternalRep(dictPtr)
     Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr;
 
     --dict->refcount;
-    if (dict->refcount == 0) {
+    if (dict->refcount <= 0) {
 	DeleteDict(dict);
     }
 
@@ -977,7 +977,7 @@ Tcl_DictObjDone(searchPtr)
 	searchPtr->epoch = -1;
 	dict = (Dict *) searchPtr->dictionaryPtr;
 	dict->refcount--;
-	if (dict->refcount == 0) {
+	if (dict->refcount <= 0) {
 	    DeleteDict(dict);
 	}
     }
@@ -1093,7 +1093,7 @@ Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_NewListObj --
+ * Tcl_NewDictObj --
  *
  *	This procedure is normally called when not debugging: i.e., when
  *	TCL_MEM_DEBUG is not defined. It creates a new dict object
@@ -1128,6 +1128,7 @@ Tcl_NewDictObj()
     Tcl_InitObjHashTable(&dict->table);
     dict->epoch = 0;
     dict->chain = NULL;
+    dict->refcount = 1;
     dictPtr->internalRep.otherValuePtr = (VOID *) dict;
     dictPtr->typePtr = &tclDictType;
     return dictPtr;
@@ -1137,7 +1138,7 @@ Tcl_NewDictObj()
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_DbNewListObj --
+ * Tcl_DbNewDictObj --
  *
  *	This procedure is normally called when debugging: i.e., when
  *	TCL_MEM_DEBUG is defined. It creates new dict objects. It is the
@@ -1176,6 +1177,7 @@ Tcl_DbNewDictObj(file, line)
     Tcl_InitObjHashTable(&dict->table);
     dict->epoch = 0;
     dict->chain = NULL;
+    dict->refcount = 1;
     dictPtr->internalRep.otherValuePtr = (VOID *) dict;
     dictPtr->typePtr = &tclDictType;
     return dictPtr;
@@ -1676,7 +1678,8 @@ DictIncrCmd(interp, objc, objv)
     Tcl_Obj *CONST *objv;
 {
     Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
-    int result, incrValue;
+    int result;
+    long incrValue;
 
     if (objc < 4 || objc > 5) {
 	Tcl_WrongNumArgs(interp, 2, objv, "varName key ?increment?");
@@ -1684,7 +1687,7 @@ DictIncrCmd(interp, objc, objv)
     }
 
     if (objc == 5) {
-	result = Tcl_GetIntFromObj(interp, objv[4], &incrValue);
+	result = Tcl_GetLongFromObj(interp, objv[4], &incrValue);
 	if (result != TCL_OK) {
 	    return result;
 	}
@@ -1695,9 +1698,9 @@ DictIncrCmd(interp, objc, objv)
     dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);
     if (dictPtr == NULL) {
 	dictPtr = Tcl_NewDictObj();
-	Tcl_DictObjPut(interp, dictPtr, objv[3], Tcl_NewIntObj(incrValue));
+	Tcl_DictObjPut(interp, dictPtr, objv[3], Tcl_NewLongObj(incrValue));
     } else {
-	int iValue;
+	long lValue;
 	Tcl_WideInt wValue;
 
 	if (Tcl_IsShared(dictPtr)) {
@@ -1708,7 +1711,8 @@ DictIncrCmd(interp, objc, objv)
 	    return TCL_ERROR;
 	}
 	if (valuePtr == NULL) {
-	    valuePtr = Tcl_NewIntObj(incrValue);
+	    valuePtr = Tcl_NewLongObj(incrValue);
+#ifndef TCL_WIDE_INT_IS_LONG
 	} else if (valuePtr->typePtr == &tclWideIntType) {
 	    Tcl_GetWideIntFromObj(NULL, valuePtr, &wValue);
 	    if (Tcl_IsShared(valuePtr)) {
@@ -1720,38 +1724,45 @@ DictIncrCmd(interp, objc, objv)
 		}
 		goto valueAlreadyInDictionary;
 	    }
+#endif /* !TCL_WIDE_INT_IS_LONG */
 	} else if (valuePtr->typePtr == &tclIntType) {
-	    Tcl_GetIntFromObj(NULL, valuePtr, &iValue);
+	    Tcl_GetLongFromObj(NULL, valuePtr, &lValue);
 	    if (Tcl_IsShared(valuePtr)) {
-		valuePtr = Tcl_NewIntObj(iValue + incrValue);
+		valuePtr = Tcl_NewLongObj(lValue + incrValue);
 	    } else {
-		Tcl_SetIntObj(valuePtr, iValue + incrValue);
+		Tcl_SetLongObj(valuePtr, lValue + incrValue);
 		if (dictPtr->bytes != NULL) {
 		    Tcl_InvalidateStringRep(dictPtr);
 		}
 		goto valueAlreadyInDictionary;
 	    }
 	} else {
+	    /*
+	     * Note that these operations on wide ints should work
+	     * fine where they are the same as normal longs, though
+	     * the compiler might complain about trivially satisifed
+	     * tests.
+	     */
 	    result = Tcl_GetWideIntFromObj(interp, valuePtr, &wValue);
 	    if (result != TCL_OK) {
 		return result;
 	    }
 	    /*
-	     * Determine if we should have got a standard int instead.
+	     * Determine if we should have got a standard long instead.
 	     */
 	    if (Tcl_IsShared(valuePtr)) {
-		if (wValue >= INT_MIN && wValue <= INT_MAX) {
+		if (wValue >= LONG_MIN && wValue <= LONG_MAX) {
 		    /*
 		     * Convert the type...
 		     */
-		    Tcl_GetIntFromObj(NULL, valuePtr, &iValue);
-		    valuePtr = Tcl_NewIntObj(iValue + incrValue);
+		    Tcl_GetLongFromObj(NULL, valuePtr, &lValue);
+		    valuePtr = Tcl_NewLongObj(lValue + incrValue);
 		} else {
 		    valuePtr = Tcl_NewWideIntObj(wValue + incrValue);
 		}
 	    } else {
-		if (wValue >= INT_MIN && wValue <= INT_MAX) {
-		    Tcl_SetIntObj(valuePtr,
+		if (wValue >= LONG_MIN && wValue <= LONG_MAX) {
+		    Tcl_SetLongObj(valuePtr,
 			    Tcl_WideAsLong(wValue) + incrValue);
 		} else {
 		    Tcl_SetWideIntObj(valuePtr, wValue + incrValue);
@@ -1766,8 +1777,8 @@ DictIncrCmd(interp, objc, objv)
 	    Tcl_DecrRefCount(valuePtr);
 	    return TCL_ERROR;
 	}
-	valueAlreadyInDictionary:
     }
+  valueAlreadyInDictionary:
     resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
     if (resultPtr == NULL) {
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 1a9307e..a5e34e6 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.43 2003/04/05 01:41:23 dkf Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.44 2003/04/07 10:12:10 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -126,15 +126,18 @@ Tcl_ObjType tclIntType = {
     SetIntFromAny			/* setFromAnyProc */
 };
 
-#ifndef TCL_WIDE_INT_IS_LONG
 Tcl_ObjType tclWideIntType = {
     "wideInt",				/* name */
     (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
     (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
+#ifdef TCL_WIDE_INT_IS_LONG
+    UpdateStringOfInt,			/* updateStringProc */
+    SetIntFromAny			/* setFromAnyProc */
+#else /* !TCL_WIDE_INT_IS_LONG */
     UpdateStringOfWideInt,		/* updateStringProc */
     SetWideIntFromAny			/* setFromAnyProc */
+#endif /* TCL_WIDE_INT_IS_LONG */
 };
-#endif
 
 /*
  * The structure below defines the Tcl obj hash key type.
@@ -233,9 +236,7 @@ TclInitObjSubsystem()
     Tcl_RegisterObjType(&tclDoubleType);
     Tcl_RegisterObjType(&tclEndOffsetType);
     Tcl_RegisterObjType(&tclIntType);
-#ifndef TCL_WIDE_INT_IS_LONG
     Tcl_RegisterObjType(&tclWideIntType);
-#endif
     Tcl_RegisterObjType(&tclStringType);
     Tcl_RegisterObjType(&tclListType);
     Tcl_RegisterObjType(&tclDictType);
@@ -1108,8 +1109,10 @@ SetBooleanFromAny(interp, objPtr)
 	newBool = (objPtr->internalRep.longValue != 0);
     } else if (objPtr->typePtr == &tclDoubleType) {
 	newBool = (objPtr->internalRep.doubleValue != 0.0);
-#ifndef TCL_WIDE_INT_IS_LONG
     } else if (objPtr->typePtr == &tclWideIntType) {
+#ifdef TCL_WIDE_INT_IS_LONG
+	newBool = (objPtr->internalRep.longValue != 0);
+#else /* !TCL_WIDE_INT_IS_LONG */
 	newBool = (objPtr->internalRep.wideValue != Tcl_LongAsWide(0));
 #endif /* TCL_WIDE_INT_IS_LONG */
     } else {
diff --git a/tests/dict.test b/tests/dict.test
index 6d27533..d139c54 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: dict.test,v 1.1 2003/04/05 01:03:21 dkf Exp $
+# RCS: @(#) $Id: dict.test,v 1.2 2003/04/07 10:12:12 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -62,6 +62,14 @@ test dict-2.4 {dict create command} {
 test dict-2.5 {dict create command} {
     list [catch {dict create a b c} msg] $msg
 } {1 {wrong # args: should be "dict create ?key value ...?"}}
+test dict-2.6 {dict create command - initialse refcount field!} {
+    # Bug 715751 will show up in memory debuggers like purify
+    for {set i 0} {$i<10} {incr i} { 
+	set dictv [dict create a 0] 
+	set share [dict values $dictv] 
+	list [dict incr dictv a] 
+    } 
+} {}
 
 test dict-3.1 {dict get command} {dict get {a b} a} b
 test dict-3.2 {dict get command} {dict get {a b c d} a} b