summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog10
-rw-r--r--doc/DictObj.316
-rw-r--r--doc/dict.n31
-rw-r--r--generic/tcl.h5
-rw-r--r--generic/tclDictObj.c477
-rw-r--r--generic/tclInt.h10
-rw-r--r--generic/tclObj.c37
-rw-r--r--tests/init.test4
-rw-r--r--tests/ioCmd.test57
-rw-r--r--tests/string.test6
10 files changed, 416 insertions, 237 deletions
diff --git a/ChangeLog b/ChangeLog
index 85abf53..d712a2c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,12 @@
-2007-11-20 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+2007-11-20 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclDictObj.c: Changed the underlying implementation of the
+ hash table used in dictionaries to additionally keep all entries in
+ the hash table in a linked list, which is only ever added to at the
+ end. This makes iteration over all entries in the dictionary in
+ key insertion order a trivial operation, and so cleans up a great deal
+ of complexity relating to dictionary representation and stability of
+ iteration order.
* generic/tclConfig.c (QueryConfigObjCmd): Correct usage of
Tcl_WrongNumArgs.
diff --git a/doc/DictObj.3 b/doc/DictObj.3
index 20d3514..4e72a1c 100644
--- a/doc/DictObj.3
+++ b/doc/DictObj.3
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: DictObj.3,v 1.9 2007/06/29 22:37:27 dkf Exp $
+'\" RCS: @(#) $Id: DictObj.3,v 1.10 2007/11/20 20:43:11 dkf Exp $
'\"
.so man.macros
.TH Tcl_DictObj 3 8.5 Tcl "Tcl Library Procedures"
@@ -99,9 +99,14 @@ sub-dictionaries of the main dictionary object passed to them.
.SH DESCRIPTION
.PP
Tcl dictionary objects have an internal representation that supports
-efficient mapping from keys to values and which does not guarantee any
-particular ordering of keys within the dictionary (the underlying
-basic data-structure is a hash table created with \fBTcl_InitObjHashTable\fR).
+efficient mapping from keys to values and which guarantees that the
+particular ordering of keys within the dictionary remains the same
+modulo any keys being deleted (which removes them from the order) or
+added (which adds them to the end of the order). If reinterpreted as a
+list, the values at the even-valued indices in the list will be the
+keys of the dictionary, and each will be followed (in the odd-valued
+index) bu the value associated with that key.
+.PP
The procedures described in this man page are used to
create, modify, index, and iterate over dictionary objects from C code.
.PP
@@ -190,7 +195,7 @@ keys must exist and have dictionaries as their values.
.SH EXAMPLE
Using the dictionary iteration interface to search determine if there
is a key that maps to itself:
-
+.PP
.CS
Tcl_DictSearch search;
Tcl_Obj *key, *value;
@@ -225,7 +230,6 @@ for (; done ; \fBTcl_DictObjNext\fR(&search, &key, &value, &done)) {
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!done));
return TCL_OK;
.CE
-
.SH "SEE ALSO"
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_InitObjHashTable
.SH KEYWORDS
diff --git a/doc/dict.n b/doc/dict.n
index a1dea2c..e963f4c 100644
--- a/doc/dict.n
+++ b/doc/dict.n
@@ -4,7 +4,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.n,v 1.15 2007/10/29 01:42:18 dkf Exp $
+'\" RCS: @(#) $Id: dict.n,v 1.16 2007/11/20 20:43:11 dkf Exp $
'\"
.so man.macros
.TH dict n 8.5 Tcl "Tcl Built-In Commands"
@@ -60,7 +60,8 @@ argument after the rule selection word is a two-element list. If the
\fIscript\fR returns with a condition of \fBTCL_BREAK\fR, no further
key/value pairs are considered for inclusion in the resulting
dictionary, and a condition of \fBTCL_CONTINUE\fR is equivalent to a false
-result. The order in which the key/value pairs are tested is undefined.
+result. The key/value pairs are tested in the order in which the keys
+were inserted into the dictionary.
.TP
\fBdict filter \fIdictionaryValue \fBvalue \fIglobPattern\fR
The value rule only matches those key/value pairs whose values match
@@ -78,7 +79,8 @@ body generates a \fBTCL_BREAK\fR result, no further pairs from the
dictionary will be iterated over and the \fBdict for\fR command will
terminate successfully immediately. If any evaluation of the body
generates a \fBTCL_CONTINUE\fR result, this shall be treated exactly like a
-normal \fBTCL_OK\fR result. The order of iteration is undefined.
+normal \fBTCL_OK\fR result. The order of iteration is the order in
+which the keys were inserted into the dictionary.
.TP
\fBdict get \fIdictionaryValue \fR?\fIkey ...\fR?
Given a dictionary value (first argument) and a key (second argument),
@@ -120,11 +122,8 @@ string produced by \fBTcl_HashStats\fR, similar to \fBarray info\fR.
\fBdict keys \fIdictionaryValue \fR?\fIglobPattern\fR?
Return a list of all keys in the given dictionary value. If a pattern
is supplied, only those keys that match it (according to the rules of
-\fBstring match\fR) will be returned. The returned keys will be in an
-arbitrary implementation-specific order, though where no pattern is
-supplied the \fIi\fR'th key returned by \fBdict keys\fR will be the key for
-the \fIi\fR'th value returned by \fBdict values\fR applied to the same
-dictionary value.
+\fBstring match\fR) will be returned. The returned keys will be in the
+order that they were inserted into the dictionary.
.TP
\fBdict lappend \fIdictionaryVariable key \fR?\fIvalue ...\fR?
This appends the given items to the list value that the given key maps
@@ -194,10 +193,8 @@ contents only happen when \fIbody\fR terminates.
Return a list of all values in the given dictionary value. If a
pattern is supplied, only those values that match it (according to the
rules of \fBstring match\fR) will be returned. The returned values
-will be in an arbitrary implementation-specific order, though where no
-pattern is supplied the \fIi\fR'th key returned by \fBdict keys\fR will be
-the key for the \fIi\fR'th value returned by \fBdict values\fR applied to
-the same dictionary value.
+will be in the order of that the keys associated with those values
+were inserted into the dictionary.
.TP
\fBdict with \fIdictionaryVariable \fR?\fIkey ...\fR? \fIbody\fR
Execute the Tcl script in \fIbody\fR with the value for each key in
@@ -215,15 +212,15 @@ dictionaries no longer exists. The result of \fBdict with\fR is
traces; changes to the \fIdictionaryVariable\fR's contents only happen
when \fIbody\fR terminates.
.SH "DICTIONARY VALUES"
-Dictionaries are values that contain an efficient (but \fInot\fR
-order-preserving) mapping from arbitrary keys to arbitrary values.
+Dictionaries are values that contain an efficient, order-preserving
+mapping from arbitrary keys to arbitrary values.
They have a textual format that is exactly that of any list with an
even number of elements, with each mapping in the dictionary being
-represented as two items in the list. When a command takes a
+represented as two items in the list. When a command takes a
dictionary and produces a new dictionary based on it (either returning
it or writing it back into the variable that the starting dictionary
-was read from) there is \fIno\fR guarantee that the new dictionary
-will have the same ordering of keys.
+was read from) the new dictionary will have the same order of keys,
+modulo any deleted keys and with new keys added on to the end.
.SH EXAMPLES
Constructing and using nested dictionaries:
.CS
diff --git a/generic/tcl.h b/generic/tcl.h
index f9fdb1f..db919dc 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tcl.h,v 1.244 2007/11/19 18:14:48 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.245 2007/11/20 20:43:11 dkf Exp $
*/
#ifndef _TCL
@@ -1264,7 +1264,8 @@ typedef struct Tcl_HashSearch {
*/
typedef struct {
- Tcl_HashSearch search; /* Search struct for underlying hash table. */
+ void *next; /* Search position for underlying hash
+ * table. */
int epoch; /* Epoch marker for dictionary being searched,
* or -1 if search has terminated. */
Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index f2d6807..1a81260 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.52 2007/11/19 11:17:24 dkf Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.53 2007/11/20 20:43:11 dkf Exp $
*/
#include "tclInt.h"
@@ -26,48 +26,65 @@ struct Dict;
static void DeleteDict(struct Dict *dict);
static int DictAppendCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictCreateCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictExistsCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictFilterCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictForCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictGetCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictIncrCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictInfoCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictKeysCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictLappendCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictMergeCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictRemoveCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictReplaceCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictSetCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictSizeCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictUnsetCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictValuesCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictUpdateCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictWithCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static void DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeDictInternalRep(Tcl_Obj *dictPtr);
static void InvalidateDictChain(Tcl_Obj *dictObj);
static int SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfDict(Tcl_Obj *dictPtr);
+static Tcl_HashEntry * AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr);
+static inline void InitChainTable(struct Dict *dict);
+static inline void DeleteChainTable(struct Dict *dict);
+static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
+ Tcl_Obj *keyPtr, int *newPtr);
+static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
+
+/*
+ * Internal representation of the entries in the hash table that backs a
+ * dictionary.
+ */
+
+typedef struct ChainEntry {
+ Tcl_HashEntry entry;
+ struct ChainEntry *prevPtr;
+ struct ChainEntry *nextPtr;
+} ChainEntry;
/*
* Internal representation of a dictionary.
@@ -86,6 +103,14 @@ static void UpdateStringOfDict(Tcl_Obj *dictPtr);
typedef struct Dict {
Tcl_HashTable table; /* Object hash table to store mapping in. */
+ ChainEntry *entryChainHead; /* Linked list of all entries in the
+ * dictionary. Used for doing traversal of the
+ * entries in the order that they are
+ * created. */
+ ChainEntry *entryChainTail; /* Other end of linked list of all entries in
+ * the dictionary. Used for doing traversal of
+ * the entries in the order that they are
+ * created. */
int epoch; /* Epoch counter */
int refcount; /* Reference counter (see above) */
Tcl_Obj *chain; /* Linked list used for invalidating the
@@ -105,6 +130,153 @@ Tcl_ObjType tclDictType = {
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny /* setFromAnyProc */
};
+
+/*
+ * The type of the specially adapted version of the Tcl_Obj*-containing hash
+ * table defined in the tclObj.c code. This version differs in that it
+ * allocates a bit more space in each hash entry in order to hold the pointers
+ * used to keep the hash entries in a linked list.
+ */
+
+static Tcl_HashKeyType chainHashType = {
+ TCL_HASH_KEY_TYPE_VERSION,
+ 0,
+ TclHashObjKey,
+ TclCompareObjKeys,
+ AllocChainEntry,
+ TclFreeObjEntry
+};
+
+/***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocChainEntry --
+ *
+ * Allocate space for a Tcl_HashEntry containing the Tcl_Obj * key, and
+ * which has a bit of extra space afterwards for storing pointers to the
+ * rest of the chain of entries (the extra pointers are left NULL).
+ *
+ * Results:
+ * The return value is a pointer to the created entry.
+ *
+ * Side effects:
+ * Increments the reference count on the object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+AllocChainEntry(
+ Tcl_HashTable *tablePtr,
+ void *keyPtr)
+{
+ Tcl_Obj *objPtr = keyPtr;
+ ChainEntry *cPtr;
+
+ cPtr = (ChainEntry *) ckalloc(sizeof(ChainEntry));
+ cPtr->entry.key.oneWordValue = (char *) objPtr;
+ Tcl_IncrRefCount(objPtr);
+ cPtr->entry.clientData = NULL;
+ cPtr->prevPtr = cPtr->nextPtr = NULL;
+
+ return &cPtr->entry;
+}
+
+/*
+ * Helper functions that disguise most of the details relating to how the
+ * linked list of hash entries is managed. In particular, these manage the
+ * creation of the table and initializing of the chain, the deletion of the
+ * table and chain, the adding of an entry to the chain, and the removal of an
+ * entry from the chain.
+ */
+
+static inline void
+InitChainTable(
+ Dict *dict)
+{
+ Tcl_InitCustomHashTable(&dict->table, TCL_CUSTOM_PTR_KEYS,
+ &chainHashType);
+ dict->entryChainHead = dict->entryChainTail = NULL;
+}
+
+static inline void
+DeleteChainTable(
+ Dict *dict)
+{
+ ChainEntry *cPtr;
+
+ for (cPtr=dict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
+ Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+
+ TclDecrRefCount(valuePtr);
+ }
+ Tcl_DeleteHashTable(&dict->table);
+}
+
+static inline Tcl_HashEntry *
+CreateChainEntry(
+ Dict *dict,
+ Tcl_Obj *keyPtr,
+ int *newPtr)
+{
+ ChainEntry *cPtr = (ChainEntry *)
+ Tcl_CreateHashEntry(&dict->table, (char *) keyPtr, newPtr);
+
+ /*
+ * If this is a new entry in the hash table, stitch it into the chain.
+ */
+
+ if (*newPtr) {
+ cPtr->nextPtr = NULL;
+ if (dict->entryChainHead == NULL) {
+ cPtr->prevPtr = NULL;
+ dict->entryChainHead = cPtr;
+ dict->entryChainTail = cPtr;
+ } else {
+ cPtr->prevPtr = dict->entryChainTail;
+ dict->entryChainTail->nextPtr = cPtr;
+ dict->entryChainTail = cPtr;
+ }
+ }
+
+ return &cPtr->entry;
+}
+
+static inline int
+DeleteChainEntry(
+ Dict *dict,
+ Tcl_Obj *keyPtr)
+{
+ ChainEntry *cPtr = (ChainEntry *)
+ Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
+
+ if (cPtr == NULL) {
+ return 0;
+ } else {
+ Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+ TclDecrRefCount(valuePtr);
+ }
+
+ /*
+ * Unstitch from the chain.
+ */
+
+ if (cPtr->nextPtr) {
+ cPtr->nextPtr->prevPtr = cPtr->prevPtr;
+ } else {
+ dict->entryChainTail = cPtr->prevPtr;
+ }
+ if (cPtr->prevPtr) {
+ cPtr->prevPtr->nextPtr = cPtr->nextPtr;
+ } else {
+ dict->entryChainHead = cPtr->nextPtr;
+ }
+
+ Tcl_DeleteHashEntry(&cPtr->entry);
+ return 1;
+}
/*
*----------------------------------------------------------------------
@@ -133,29 +305,33 @@ DupDictInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
- Dict *oldDict = (Dict *) srcPtr->internalRep.otherValuePtr;
+ Dict *oldDict = srcPtr->internalRep.otherValuePtr;
Dict *newDict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_HashEntry *hPtr, *newHPtr;
- Tcl_HashSearch search;
- Tcl_Obj *keyPtr, *valuePtr;
- int isNew;
+ ChainEntry *cPtr;
/*
* Copy values across from the old hash table.
*/
- Tcl_InitObjHashTable(&newDict->table);
- for (hPtr=Tcl_FirstHashEntry(&oldDict->table,&search); hPtr!=NULL;
- hPtr=Tcl_NextHashEntry(&search)) {
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&oldDict->table, hPtr);
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- newHPtr = Tcl_CreateHashEntry(&newDict->table, (char *)keyPtr, &isNew);
- Tcl_SetHashValue(newHPtr, (ClientData)valuePtr);
+
+ InitChainTable(newDict);
+ for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
+ void *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
+ Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+ int n;
+ Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n);
+
+ /*
+ * Fill in the contents.
+ */
+
+ Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
Tcl_IncrRefCount(valuePtr);
}
/*
* Initialise other fields.
*/
+
newDict->epoch = 0;
newDict->chain = NULL;
newDict->refcount = 1;
@@ -163,7 +339,8 @@ DupDictInternalRep(
/*
* Store in the object.
*/
- copyPtr->internalRep.otherValuePtr = (void *) newDict;
+
+ copyPtr->internalRep.otherValuePtr = newDict;
copyPtr->typePtr = &tclDictType;
}
@@ -189,7 +366,7 @@ static void
FreeDictInternalRep(
Tcl_Obj *dictPtr)
{
- Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr;
+ Dict *dict = dictPtr->internalRep.otherValuePtr;
--dict->refcount;
if (dict->refcount <= 0) {
@@ -223,22 +400,7 @@ static void
DeleteDict(
Dict *dict)
{
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
- Tcl_Obj *valuePtr;
-
- /*
- * Delete the values ourselves, because hashes know nothing about their
- * contents (but do know about the key type, so that doesn't need explicit
- * attention.)
- */
-
- for (hPtr=Tcl_FirstHashEntry(&dict->table,&search); hPtr!=NULL;
- hPtr=Tcl_NextHashEntry(&search)) {
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- TclDecrRefCount(valuePtr);
- }
- Tcl_DeleteHashTable(&dict->table);
+ DeleteChainTable(dict);
ckfree((char *) dict);
}
@@ -270,9 +432,8 @@ UpdateStringOfDict(
{
#define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr;
- Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
+ Dict *dict = dictPtr->internalRep.otherValuePtr;
+ ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int numElems, i, length;
char *elem, *dst;
@@ -294,19 +455,18 @@ UpdateStringOfDict(
flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
}
dictPtr->length = 1;
- for (i=0,hPtr=Tcl_FirstHashEntry(&dict->table,&search) ; i<numElems ;
- i+=2,hPtr=Tcl_NextHashEntry(&search)) {
+ for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
- * Assume that hPtr is never NULL since we know the number of array
+ * Assume that cPtr is never NULL since we know the number of array
* elements already.
*/
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);
+ keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
dictPtr->length += Tcl_ScanCountedElement(elem, length,
&flagPtr[i]) + 1;
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ valuePtr = Tcl_GetHashValue(&cPtr->entry);
elem = TclGetStringFromObj(valuePtr, &length);
dictPtr->length += Tcl_ScanCountedElement(elem, length,
&flagPtr[i+1]) + 1;
@@ -318,15 +478,14 @@ UpdateStringOfDict(
dictPtr->bytes = ckalloc((unsigned) dictPtr->length);
dst = dictPtr->bytes;
- for (i=0,hPtr=Tcl_FirstHashEntry(&dict->table,&search) ; i<numElems ;
- i+=2,hPtr=Tcl_NextHashEntry(&search)) {
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);
+ for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
+ keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH) );
+ flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
*(dst++) = ' ';
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ valuePtr = Tcl_GetHashValue(&cPtr->entry);
elem = TclGetStringFromObj(valuePtr, &length);
dst += Tcl_ConvertCountedElement(elem, length, dst,
flagPtr[i+1] | TCL_DONT_QUOTE_HASH);
@@ -369,14 +528,13 @@ SetDictFromAny(
Tcl_Obj *objPtr)
{
char *string, *s;
- CONST char *elemStart, *nextElem;
+ const char *elemStart, *nextElem;
int lenRemain, length, elemSize, hasBrace, result, isNew;
char *limit; /* Points just after string's last byte. */
- register CONST char *p;
+ register const char *p;
register Tcl_Obj *keyPtr, *valuePtr;
Dict *dict;
Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
/*
* Since lists and dictionaries have very closely-related string
@@ -411,20 +569,22 @@ SetDictFromAny(
/*
* Build the hash of key/value pairs.
*/
+
dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
+ InitChainTable(dict);
for (i=0 ; i<objc ; i+=2) {
/*
* Store key and value in the hash table we're building.
*/
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)objv[i], &isNew);
+ hPtr = CreateChainEntry(dict, objv[i], &isNew);
if (!isNew) {
- Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
+
TclDecrRefCount(discardedValue);
}
- Tcl_SetHashValue(hPtr, (ClientData) objv[i+1]);
- Tcl_IncrRefCount(objv[i+1]); /* since hash now holds ref to it */
+ Tcl_SetHashValue(hPtr, objv[i+1]);
+ Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
}
/*
@@ -447,7 +607,7 @@ SetDictFromAny(
*/
dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
+ InitChainTable(dict);
for (p = string, lenRemain = length;
lenRemain > 0;
p = nextElem, lenRemain = (limit - nextElem)) {
@@ -514,17 +674,18 @@ SetDictFromAny(
* Store key and value in the hash table we're building.
*/
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew);
+ hPtr = CreateChainEntry(dict, keyPtr, &isNew);
if (!isNew) {
- Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
+
TclDecrRefCount(keyPtr);
TclDecrRefCount(discardedValue);
}
- Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
+ Tcl_SetHashValue(hPtr, valuePtr);
Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
}
- installHash:
+ installHash:
/*
* Free the old internalRep before setting the new one. We do this as late
* as possible to allow the conversion code, in particular
@@ -535,24 +696,19 @@ SetDictFromAny(
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- objPtr->internalRep.otherValuePtr = (void *) dict;
+ objPtr->internalRep.otherValuePtr = dict;
objPtr->typePtr = &tclDictType;
return TCL_OK;
- missingKey:
+ missingKey:
if (interp != NULL) {
Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
}
TclDecrRefCount(keyPtr);
result = TCL_ERROR;
- errorExit:
- for (hPtr=Tcl_FirstHashEntry(&dict->table,&search);
- hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- TclDecrRefCount(valuePtr);
- }
- Tcl_DeleteHashTable(&dict->table);
+ errorExit:
+ DeleteChainTable(dict);
ckfree((char *) dict);
return result;
}
@@ -594,7 +750,7 @@ TclTraceDictPath(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
int keyc,
- Tcl_Obj *CONST keyv[],
+ Tcl_Obj *const keyv[],
int flags)
{
Dict *dict, *newDict;
@@ -605,7 +761,7 @@ TclTraceDictPath(
return NULL;
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.otherValuePtr;
if (flags & DICT_PATH_UPDATE) {
dict->chain = NULL;
}
@@ -616,6 +772,7 @@ TclTraceDictPath(
if (hPtr == NULL) {
int isNew; /* Dummy */
+
if (flags & DICT_PATH_EXISTS) {
return DICT_PATH_NON_EXISTENT;
}
@@ -633,12 +790,13 @@ TclTraceDictPath(
/*
* The next line should always set isNew to 1.
*/
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyv[i], &isNew);
+
+ hPtr = CreateChainEntry(dict, keyv[i], &isNew);
tmpObj = Tcl_NewDictObj();
Tcl_IncrRefCount(tmpObj);
- Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
+ Tcl_SetHashValue(hPtr, tmpObj);
} else {
- tmpObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ tmpObj = Tcl_GetHashValue(hPtr);
if (tmpObj->typePtr != &tclDictType) {
if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
return NULL;
@@ -646,7 +804,7 @@ TclTraceDictPath(
}
}
- newDict = (Dict *) tmpObj->internalRep.otherValuePtr;
+ newDict = tmpObj->internalRep.otherValuePtr;
if (flags & DICT_PATH_UPDATE) {
if (Tcl_IsShared(tmpObj)) {
TclDecrRefCount(tmpObj);
@@ -654,7 +812,7 @@ TclTraceDictPath(
Tcl_IncrRefCount(tmpObj);
Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
dict->epoch++;
- newDict = (Dict *) tmpObj->internalRep.otherValuePtr;
+ newDict = tmpObj->internalRep.otherValuePtr;
}
newDict->chain = dictPtr;
@@ -689,7 +847,7 @@ static void
InvalidateDictChain(
Tcl_Obj *dictObj)
{
- Dict *dict = (Dict *) dictObj->internalRep.otherValuePtr;
+ Dict *dict = dictObj->internalRep.otherValuePtr;
do {
Tcl_InvalidateStringRep(dictObj);
@@ -699,7 +857,7 @@ InvalidateDictChain(
break;
}
dict->chain = NULL;
- dict = (Dict *) dictObj->internalRep.otherValuePtr;
+ dict = dictObj->internalRep.otherValuePtr;
} while (dict != NULL);
}
@@ -739,6 +897,7 @@ Tcl_DictObjPut(
if (dictPtr->typePtr != &tclDictType) {
int result = SetDictFromAny(interp, dictPtr);
+
if (result != TCL_OK) {
return result;
}
@@ -747,11 +906,12 @@ Tcl_DictObjPut(
if (dictPtr->bytes != NULL) {
Tcl_InvalidateStringRep(dictPtr);
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew);
+ dict = dictPtr->internalRep.otherValuePtr;
+ hPtr = CreateChainEntry(dict, keyPtr, &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
- Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
+
TclDecrRefCount(oldValuePtr);
}
Tcl_SetHashValue(hPtr, valuePtr);
@@ -796,12 +956,12 @@ Tcl_DictObjGet(
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyPtr);
+ dict = dictPtr->internalRep.otherValuePtr;
+ hPtr = Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
if (hPtr == NULL) {
*valuePtrPtr = NULL;
} else {
- *valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ *valuePtrPtr = Tcl_GetHashValue(hPtr);
}
return TCL_OK;
}
@@ -832,7 +992,6 @@ Tcl_DictObjRemove(
Tcl_Obj *keyPtr)
{
Dict *dict;
- Tcl_HashEntry *hPtr;
if (Tcl_IsShared(dictPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
@@ -848,13 +1007,8 @@ Tcl_DictObjRemove(
if (dictPtr->bytes != NULL) {
Tcl_InvalidateStringRep(dictPtr);
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyPtr);
- if (hPtr != NULL) {
- Tcl_Obj *valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
-
- TclDecrRefCount(valuePtr);
- Tcl_DeleteHashEntry(hPtr);
+ dict = dictPtr->internalRep.otherValuePtr;
+ if (DeleteChainEntry(dict, keyPtr)) {
dict->epoch++;
}
return TCL_OK;
@@ -893,7 +1047,7 @@ Tcl_DictObjSize(
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.otherValuePtr;
*sizePtr = dict->table.numEntries;
return TCL_OK;
}
@@ -938,30 +1092,33 @@ Tcl_DictObjFirst(
* otherwise. */
{
Dict *dict;
- Tcl_HashEntry *hPtr;
+ ChainEntry *cPtr;
if (dictPtr->typePtr != &tclDictType) {
int result = SetDictFromAny(interp, dictPtr);
+
if (result != TCL_OK) {
return result;
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FirstHashEntry(&dict->table, &searchPtr->search);
- if (hPtr == NULL) {
+ dict = dictPtr->internalRep.otherValuePtr;
+ cPtr = dict->entryChainHead;
+ if (cPtr == NULL) {
searchPtr->epoch = -1;
*donePtr = 1;
} else {
*donePtr = 0;
searchPtr->dictionaryPtr = (Tcl_Dict) dict;
searchPtr->epoch = dict->epoch;
+ searchPtr->next = cPtr->nextPtr;
dict->refcount++;
if (keyPtrPtr != NULL) {
- *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);
+ *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table,
+ &cPtr->entry);
}
if (valuePtrPtr != NULL) {
- *valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
}
}
return TCL_OK;
@@ -1004,7 +1161,7 @@ Tcl_DictObjNext(
* values in the dictionary, or a 0
* otherwise. */
{
- Tcl_HashEntry *hPtr;
+ ChainEntry *cPtr;
/*
* If the searh is done; we do no work.
@@ -1024,20 +1181,21 @@ Tcl_DictObjNext(
Tcl_Panic("concurrent dictionary modification and search");
}
- hPtr = Tcl_NextHashEntry(&searchPtr->search);
- if (hPtr == NULL) {
+ cPtr = searchPtr->next;
+ if (cPtr == NULL) {
Tcl_DictObjDone(searchPtr);
*donePtr = 1;
return;
}
+ searchPtr->next = cPtr->nextPtr;
*donePtr = 0;
if (keyPtrPtr != NULL) {
*keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(
- &((Dict *)searchPtr->dictionaryPtr)->table, hPtr);
+ &((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry);
}
if (valuePtrPtr != NULL) {
- *valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
}
}
@@ -1101,7 +1259,7 @@ Tcl_DictObjPutKeyList(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
int keyc,
- Tcl_Obj *CONST keyv[],
+ Tcl_Obj *const keyv[],
Tcl_Obj *valuePtr)
{
Dict *dict;
@@ -1120,11 +1278,11 @@ Tcl_DictObjPutKeyList(
return TCL_ERROR;
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyv[keyc-1], &isNew);
+ dict = dictPtr->internalRep.otherValuePtr;
+ hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
- Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
TclDecrRefCount(oldValuePtr);
}
Tcl_SetHashValue(hPtr, valuePtr);
@@ -1160,10 +1318,9 @@ Tcl_DictObjRemoveKeyList(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
int keyc,
- Tcl_Obj *CONST keyv[])
+ Tcl_Obj *const keyv[])
{
Dict *dict;
- Tcl_HashEntry *hPtr;
if (Tcl_IsShared(dictPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_DictObjRemoveKeyList");
@@ -1177,13 +1334,8 @@ Tcl_DictObjRemoveKeyList(
return TCL_ERROR;
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[keyc-1]);
- if (hPtr != NULL) {
- Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- TclDecrRefCount(oldValuePtr);
- Tcl_DeleteHashEntry(hPtr);
- }
+ dict = dictPtr->internalRep.otherValuePtr;
+ DeleteChainEntry(dict, keyv[keyc-1]);
InvalidateDictChain(dictPtr);
return TCL_OK;
}
@@ -1224,11 +1376,11 @@ Tcl_NewDictObj(void)
TclNewObj(dictPtr);
Tcl_InvalidateStringRep(dictPtr);
dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
+ InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = (void *) dict;
+ dictPtr->internalRep.otherValuePtr = dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#endif
@@ -1263,7 +1415,7 @@ Tcl_NewDictObj(void)
Tcl_Obj *
Tcl_DbNewDictObj(
- CONST char *file,
+ const char *file,
int line)
{
#ifdef TCL_MEM_DEBUG
@@ -1273,11 +1425,11 @@ Tcl_DbNewDictObj(
TclDbNewObj(dictPtr, file, line);
Tcl_InvalidateStringRep(dictPtr);
dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
+ InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = (void *) dict;
+ dictPtr->internalRep.otherValuePtr = dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#else /* !TCL_MEM_DEBUG */
@@ -1309,7 +1461,7 @@ static int
DictCreateCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictObj;
int i;
@@ -1358,7 +1510,7 @@ static int
DictGetCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr = NULL;
int result;
@@ -1448,7 +1600,7 @@ static int
DictReplaceCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
int i, result;
@@ -1499,7 +1651,7 @@ static int
DictRemoveCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
int i, result;
@@ -1550,7 +1702,7 @@ static int
DictMergeCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *targetObj, *keyObj, *valueObj;
int allocatedDict = 0;
@@ -1635,7 +1787,7 @@ static int
DictKeysCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *listPtr;
char *pattern = NULL;
@@ -1716,7 +1868,7 @@ static int
DictValuesCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *valuePtr, *listPtr;
Tcl_DictSearch search;
@@ -1772,7 +1924,7 @@ static int
DictSizeCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
int result, size;
@@ -1809,7 +1961,7 @@ static int
DictExistsCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr;
int result;
@@ -1858,7 +2010,7 @@ static int
DictInfoCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
Dict *dict;
@@ -1875,12 +2027,13 @@ DictInfoCmd(
return result;
}
}
- dict = (Dict *)dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.otherValuePtr;
+
/*
* This next cast is actually OK.
*/
- Tcl_SetResult(interp, (char *)Tcl_HashStats(&dict->table), TCL_DYNAMIC);
+ Tcl_SetResult(interp, (char *) Tcl_HashStats(&dict->table), TCL_DYNAMIC);
return TCL_OK;
}
@@ -1906,7 +2059,7 @@ static int
DictIncrCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
int code = TCL_OK;
Tcl_Obj *dictPtr, *valuePtr = NULL;
@@ -2018,7 +2171,7 @@ static int
DictLappendCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int i, allocatedDict = 0, allocatedValue = 0;
@@ -2104,7 +2257,7 @@ static int
DictAppendCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int i, allocatedDict = 0;
@@ -2175,7 +2328,7 @@ static int
DictForCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Interp* iPtr = (Interp*) interp;
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
@@ -2299,7 +2452,7 @@ static int
DictSetCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
@@ -2358,7 +2511,7 @@ static int
DictUnsetCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
@@ -2416,10 +2569,10 @@ static int
DictFilterCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Interp* iPtr = (Interp*) interp;
- static CONST char *filters[] = {
+ static const char *filters[] = {
"key", "script", "value", NULL
};
enum FilterTypes {
@@ -2675,7 +2828,7 @@ static int
DictUpdateCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *objPtr;
int i, result, dummy;
@@ -2801,7 +2954,7 @@ static int
DictWithCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Interp* iPtr = (Interp*) interp;
Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
@@ -2988,9 +3141,9 @@ Tcl_DictObjCmd(
/*ignored*/ ClientData clientData,
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
- static CONST char *subcommands[] = {
+ static const char *subcommands[] = {
"append", "create", "exists", "filter", "for",
"get", "incr", "info", "keys", "lappend", "merge",
"remove", "replace", "set", "size", "unset",
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b40786c..479232b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.348 2007/11/18 21:59:25 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.349 2007/11/20 20:43:12 dkf Exp $
*/
#ifndef _TCLINT
@@ -3195,6 +3195,14 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
int flags, int leaveErrMsg, int index);
/*
+ * So tclObj.c and tclDictObj.c can share these implementations.
+ */
+
+MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr);
+MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
+
+/*
*----------------------------------------------------------------
* Macros used by the Tcl core to create and release Tcl objects.
* TclNewObj(objPtr) creates a new object denoting an empty string.
diff --git a/generic/tclObj.c b/generic/tclObj.c
index f44f3af..91b3f35 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -13,7 +13,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.137 2007/11/11 19:32:16 msofer Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.138 2007/11/20 20:43:12 dkf Exp $
*/
#include "tclInt.h"
@@ -188,9 +188,6 @@ static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
*/
static Tcl_HashEntry * AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr);
-static int CompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
-static void FreeObjEntry(Tcl_HashEntry *hPtr);
-static unsigned int HashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Prototypes for the CommandName object type.
@@ -258,12 +255,12 @@ Tcl_ObjType tclBignumType = {
*/
Tcl_HashKeyType tclObjHashKeyType = {
- TCL_HASH_KEY_TYPE_VERSION, /* version */
- 0, /* flags */
- HashObjKey, /* hashKeyProc */
- CompareObjKeys, /* compareKeysProc */
- AllocObjEntry, /* allocEntryProc */
- FreeObjEntry /* freeEntryProc */
+ TCL_HASH_KEY_TYPE_VERSION, /* version */
+ 0, /* flags */
+ TclHashObjKey, /* hashKeyProc */
+ TclCompareObjKeys, /* compareKeysProc */
+ AllocObjEntry, /* allocEntryProc */
+ TclFreeObjEntry /* freeEntryProc */
};
/*
@@ -3325,14 +3322,14 @@ AllocObjEntry(
hPtr->key.oneWordValue = (char *) objPtr;
Tcl_IncrRefCount(objPtr);
hPtr->clientData = NULL;
-
+
return hPtr;
}
/*
*----------------------------------------------------------------------
*
- * CompareObjKeys --
+ * TclCompareObjKeys --
*
* Compares two Tcl_Obj * keys.
*
@@ -3346,8 +3343,8 @@ AllocObjEntry(
*----------------------------------------------------------------------
*/
-static int
-CompareObjKeys(
+int
+TclCompareObjKeys(
void *keyPtr, /* New key to compare. */
Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
@@ -3395,7 +3392,7 @@ CompareObjKeys(
/*
*----------------------------------------------------------------------
*
- * FreeObjEntry --
+ * TclFreeObjEntry --
*
* Frees space for a Tcl_HashEntry containing the Tcl_Obj * key.
*
@@ -3408,8 +3405,8 @@ CompareObjKeys(
*----------------------------------------------------------------------
*/
-static void
-FreeObjEntry(
+void
+TclFreeObjEntry(
Tcl_HashEntry *hPtr) /* Hash entry to free. */
{
Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
@@ -3421,7 +3418,7 @@ FreeObjEntry(
/*
*----------------------------------------------------------------------
*
- * HashObjKey --
+ * TclHashObjKey --
*
* Compute a one-word summary of the string representation of the
* Tcl_Obj, which can be used to generate a hash index.
@@ -3436,8 +3433,8 @@ FreeObjEntry(
*----------------------------------------------------------------------
*/
-static unsigned int
-HashObjKey(
+unsigned int
+TclHashObjKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
{
diff --git a/tests/init.test b/tests/init.test
index 520a731..c5907d8 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -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: init.test,v 1.16 2007/09/07 15:51:26 dgp Exp $
+# RCS: @(#) $Id: init.test,v 1.17 2007/11/20 20:43:13 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -207,7 +207,7 @@ test init-5.0 {return options passed through ::unknown} -setup {
list $code $foo $bar $code2 $foo2 $bar2
} -cleanup {
unset ::auto_index(::xxx)
-} -result {2 xxx {-code 1 -level 1 -errorcode NONE} 2 xxx {-code 1 -level 1 -errorcode NONE}}
+} -result {2 xxx {-errorcode NONE -code 1 -level 1} 2 xxx {-code 1 -level 1 -errorcode NONE}}
cleanupTests
} ;# End of [interp eval $testInterp]
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 9d39de9..baf7ae3 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: ioCmd.test,v 1.32 2007/11/19 14:22:26 dkf Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.33 2007/11/20 20:43:13 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -761,6 +761,10 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
proc note {item} {global res; lappend res $item; return}
proc track {} {upvar args item; note $item; return}
proc notes {items} {foreach i $items {note $i}}
+# This forces the return options to be in the order that the test expects!
+proc noteOpts opts {global res; lappend res [dict merge {
+ -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
+} $opts]; return}
# Helper command, canned result for 'initialize' method.
# Gets the optional methods as arguments. Use return features
@@ -858,13 +862,15 @@ test iocmd-22.8 {chan finalize, for close, custom code, close error} -match glob
rename foo {}
set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*}
-test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -body {
+test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -setup {
set res {}
+} -body {
proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
note [set c [chan create {r w} foo]]
- note [catch {close $c} msg opt]; note $msg; note $opt
+ note [catch {close $c} msg opt]; note $msg; noteOpts $opt
+ return $res
+} -cleanup {
rename foo {}
- set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}
# --- === *** ###########################
@@ -960,7 +966,7 @@ test iocmd-23.8 {chan read, level is squashed} -match glob -body {
return -level 55 -code 777 BOOM!
}
set c [chan create {r w} foo]
- note [catch {read $c 2} msg opt]; note $msg; note $opt
+ note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
close $c
rename foo {}
set res
@@ -1100,7 +1106,7 @@ test iocmd-24.13 {chan write, failed write, level is ignored} -match glob -body
set c [chan create {r w} foo]
note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
note $msg
- note $opt
+ noteOpts $opt
close $c
rename foo {}
set res
@@ -1218,7 +1224,7 @@ test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
return -level 55 -code 777 BANG
}
set c [chan create {r w} foo]
- note [catch {fconfigure $c} msg opt]; note $msg; note $opt
+ note [catch {fconfigure $c} msg opt]; note $msg; noteOpts $opt
close $c
rename foo {}
set res
@@ -1302,7 +1308,7 @@ test iocmd-26.7 {chan configure, set option, level is ignored} -match glob -body
return -level 55 -code 444 BANG
}
set c [chan create {r w} foo]
- note [catch {fconfigure $c -rc-foo bar} msg opt]; note $msg; note $opt
+ note [catch {fconfigure $c -rc-foo bar} msg opt]; note $msg; noteOpts $opt
close $c
rename foo {}
set res
@@ -1375,7 +1381,7 @@ test iocmd-27.6 {chan configure, get option, level is ignored} -match glob -body
return -level 77 -code 333 BANG
}
set c [chan create {r w} foo]
- note [catch {fconfigure $c -rc-foo} msg opt]; note $msg; note $opt
+ note [catch {fconfigure $c -rc-foo} msg opt]; note $msg; noteOpts $opt
close $c
rename foo {}
set res
@@ -1433,7 +1439,7 @@ test iocmd-28.6 {chan tell, level is ignored} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG}
set c [chan create {r w} foo]
- note [catch {tell $c} msg opt]; note $msg; note $opt
+ note [catch {tell $c} msg opt]; note $msg; noteOpts $opt
close $c
rename foo {}
set res
@@ -1514,7 +1520,7 @@ test iocmd-28.15 {chan seek, level is ignored} -match glob -body {
set res {}
proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG}
set c [chan create {r w} foo]
- note [catch {seek $c 0 start} msg opt]; note $msg; note $opt
+ note [catch {seek $c 0 start} msg opt]; note $msg; noteOpts $opt
close $c
rename foo {}
set res
@@ -1650,14 +1656,16 @@ test iocmd-29.9 {chan blocking, custom return is error} -match glob -body {
rename foo {}
set res
} -result {{blocking rc* 0} 1 *bad code*}
-test iocmd-29.10 {chan blocking, level is ignored} -match glob -body {
+test iocmd-29.10 {chan blocking, level is ignored} -match glob -setup {
set res {}
+} -body {
proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG}
set c [chan create {r w} foo]
- note [catch {fconfigure $c -blocking 0} msg opt]; note $msg; note $opt
+ note [catch {fconfigure $c -blocking 0} msg opt]; note $msg; noteOpts $opt
catch {close $c}
+ return $res
+} -cleanup {
rename foo {}
- set res
} -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}}
test iocmd-29.11 {chan blocking, regular return ok, value ignored} -match glob -body {
set res {}
@@ -1840,6 +1848,9 @@ proc inthread {chan script args} {
testthread send $tid {
proc note {item} {global notes; lappend notes $item}
proc notes {} {global notes; return $notes}
+ proc noteOpts opts {global notes; lappend notes [dict merge {
+ -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
+ } $opts]}
}
testthread send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
@@ -1960,7 +1971,7 @@ test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match
proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
note [set c [chan create {r w} foo]]
notes [inthread $c {
- note [catch {close $c} msg opt]; note $msg; note $opt
+ note [catch {close $c} msg opt]; note $msg; noteOpts $opt
notes
} c]
rename foo {}
@@ -2087,7 +2098,7 @@ test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
}
set c [chan create {r w} foo]
notes [inthread $c {
- note [catch {read $c 2} msg opt]; note $msg; note $opt
+ note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
close $c
notes
} c]
@@ -2273,7 +2284,7 @@ test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -bo
notes [inthread $c {
note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
note $msg
- note $opt
+ noteOpts $opt
close $c
notes
} c]
@@ -2436,7 +2447,7 @@ test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -bod
notes [inthread $c {
note [catch {fconfigure $c} msg opt]
note $msg
- note $opt
+ noteOpts $opt
close $c
notes
} c]
@@ -2551,7 +2562,7 @@ test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -b
notes [inthread $c {
note [catch {fconfigure $c -rc-foo bar} msg opt]
note $msg
- note $opt
+ noteOpts $opt
close $c
notes
} c]
@@ -2652,7 +2663,7 @@ test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -b
notes [inthread $c {
note [catch {fconfigure $c -rc-foo} msg opt]
note $msg
- note $opt
+ noteOpts $opt
close $c
notes
} c]
@@ -2740,7 +2751,7 @@ test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body {
notes [inthread $c {
note [catch {tell $c} msg opt]
note $msg
- note $opt
+ noteOpts $opt
close $c
notes
} c]
@@ -2866,7 +2877,7 @@ test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body {
notes [inthread $c {
note [catch {seek $c 0 start} msg opt]
note $msg
- note $opt
+ noteOpts $opt
close $c
notes
} c]
@@ -3070,7 +3081,7 @@ test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body {
notes [inthread $c {
note [catch {fconfigure $c -blocking 0} msg opt]
note $msg
- note $opt
+ noteOpts $opt
catch {close $c}
notes
} c]
diff --git a/tests/string.test b/tests/string.test
index f6c4954..e421738 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: string.test,v 1.66 2007/11/01 11:11:45 dkf Exp $
+# RCS: @(#) $Id: string.test,v 1.67 2007/11/20 20:43:13 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -821,10 +821,10 @@ test string-10.18 {string map, empty argument} {
test string-10.19 {string map, empty arguments} {
string map -nocase {{} abc f bar {} def} foo
} baroo
-test string-10.20 {string map, dictionaries can alter map ordering} {
+test string-10.20 {string map, dictionaries don't alter map ordering} {
set map {aa X a Y}
list [string map [dict create aa X a Y] aaa] [string map $map aaa] [dict size $map] [string map $map aaa]
-} {YYY XY 2 XY}
+} {XY XY 2 XY}
test string-10.21 {string map, ABR checks} {
string map {longstring foob} long
} long