diff options
| -rw-r--r-- | ChangeLog | 15 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 51 | ||||
| -rw-r--r-- | generic/tclObj.c | 15 | ||||
| -rw-r--r-- | tests/dict.test | 10 |
4 files changed, 64 insertions, 27 deletions
@@ -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 |