The bulk of the TIP#111 implementation. Still need to finish plumbing this

into the rest of the core, but that won't take long...

5 files changed, 3638 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 3ac0fb5..76f59d1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2003-04-05  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* doc/DictObj.3:	New files containing dictionary
+	* doc/dict.n:		implementation, documentation and tests
+	* generic/tclDictObj.c:	as mandated by TIP #111.
+	* tests/dict.test:
+
 2003-04-03  Mo DeJong  <mdejong@users.sourceforge.net>
 
 	* unix/configure:
diff --git a/doc/DictObj.3 b/doc/DictObj.3
new file mode 100644
index 0000000..24f41dd
--- /dev/null
+++ b/doc/DictObj.3
@@ -0,0 +1,184 @@
+'\"
+'\" Copyright (c) 2003 Donal K. Fellows
+'\"
+'\" 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.1 2003/04/05 01:03:20 dkf Exp $
+'\" 
+.so man.macros
+.TH Tcl_DictObj 3 8.5 Tcl "Tcl Library Procedures"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_NewDictObj, Tcl_DictObjPut, Tcl_DictObjGet, Tcl_DictObjRemove, Tcl_DictObjSize, Tcl_DictObjFirst, Tcl_DictObjNext, Tcl_DictObjDone, Tcl_DictObjPutKeyList, Tcl_DictObjRemoveKeyList \- manipulate Tcl objects as dictionaries
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+Tcl_Obj *
+\fBTcl_NewDictObj\fR()
+.sp
+int
+\fBTcl_DictObjGet\fR(\fIinterp, dictPtr, keyPtr, valuePtrPtr\fR)
+.sp
+int
+\fBTcl_DictObjPut\fR(\fIinterp, dictPtr, keyPtr, valuePtr\fR)
+.sp
+int
+\fBTcl_DictObjRemove\fR(\fIinterp, dictPtr, keyPtr\fR)
+.sp
+int
+\fBTcl_DictObjSize\fR(\fIinterp, dictPtr, sizePtr\fR)
+.sp
+int
+\fBTcl_DictObjFirst\fR(\fIinterp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr\fR)
+.sp
+void
+\fBTcl_DictObjNext\fR(\fIsearchPtr, keyPtrPtr, valuePtrPtr, donePtr\fR)
+.sp
+void
+\fBTcl_DictObjDone\fR(\fIsearchPtr\fR)
+.sp
+int
+\fBTcl_DictObjPutKeyList\fR(\fIinterp, dictPtr, keyc, keyv, valuePtr\fR)
+.sp
+int
+\fBTcl_DictObjRemoveKeyList\fR(\fIinterp, dictPtr, keyc, keyv\fR)
+.SH ARGUMENTS
+.AS Tcl_DictSearch "**valuePtrPtr" out
+.AP Tcl_Interp *interp in
+If an error occurs while converting an object to be a dictionary object,
+an error message is left in the interpreter's result object
+unless \fIinterp\fR is NULL.
+.AP Tcl_Obj *dictPtr in/out
+Points to the dictionary object to be manipulated.
+If \fIdictPtr\fR does not already point to a dictionary object,
+an attempt will be made to convert it to one.
+.AP Tcl_Obj *keyPtr in
+Points to the key for the key/value pair being manipulated within the
+dictionary object.
+.AP Tcl_Obj *valuePtr in
+Points to the value for the key/value pair being manipulate within the
+dictionary object (or sub-object, in the case of
+\fBTcl_DictObjPutKeyList\fR.)
+.AP Tcl_Obj **valuePtrPtr out
+Points to a variable that will have the value from a key/value pair
+placed within it.  For \fBTcl_DictObjFirst\fR and
+\fBTcl_DictObjNext\fR, this may be NULL to indicate that the caller is
+not interested in the value.
+.AP Tcl_Obj **valuePtrPtr out
+Points to a variable that will have the key from a key/value pair
+placed within it.  May be NULL to indicate that the caller is not
+interested in the key.
+.AP int *sizePtr out
+Points to a variable that will have the number of key/value pairs
+contained within the dictionary placed within it.
+.AP Tcl_DictSearch *searchPtr in/out
+Pointer to record to use to keep track of progress in enumerating all
+key/value pairs in a dictionary.  The contents of the record will be
+initialised by the call to \fBTcl_DictObjFirst\fR.  If the enumerating
+is to be terminated before all values in the dictionary have been
+returned, the search record \fImust\fR be passed to
+\fBTcl_DictObjDone\fR to enable the internal locks to be released.
+.AP int *donePtr out
+Points to a variable that will have a non-zero value written into it
+when the enumeration of the key/value pairs in a dictionary has
+completed, and a zero otherwise.
+.AP int keyc in
+Indicates the number of keys that will be supplied in the \fIkeyv\fR
+array.
+.AP "Tcl_Obj *CONST" *keyv in
+Array of \fIkeyc\fR pointers to objects that
+\fBTcl_DictObjPutKeyList\fR and \fBTcl_DictObjRemoveKeyList\fR will
+use to locate the key/value pair to manipulate within the
+sub-dictionaries of the main dictionary object passed to them.
+.BE
+
+.SH DESCRIPTION
+.PP
+Tcl dict objects have an internal representation that supports
+efficient mapping from keys to values.
+The procedures described in this man page are used to
+create, modify, index, and iterate over Tcl dict objects from C code.
+.PP
+\fBTcl_NewDictObj\fR creates a new, empty dictionary object.  The
+string representation of the object will be invalid, and the reference
+count of the object will be zero.
+.PP
+\fBTcl_DictObjGet\fR looks up the given key within the given
+dictionary and writes a pointer to the value associated with that key
+into the variable pointed to by \fIvaluePtrPtr\fR, or a NULL if the
+key has no mapping within the dictionary.  The result of this
+procedure is TCL_OK, or TCL_ERROR if the \fIdictPtr\fR cannot be
+converted to a dictionary.
+.PP
+\fBTcl_DictObjPut\fR updates the given dictionary so that the given
+key maps to the given value; any key may exist at most once in any
+particular dictionary.  The dictionary must not be shared, but the key
+and value may be.  This procedure may increase the reference count of
+both key and value if it proves necessary to store them.  Neither key
+nor value should be NULL.  The result of this procedure is TCL_OK, or
+TCL_ERROR if the \fIdictPtr\fR cannot be converted to a dictionary.
+.PP
+\fBTcl_DictObjRemove\fR updates the given dictionary so that the given
+key has no mapping to any value.  The dictionary must not be shared,
+but the key may be.  The key actually stored in the dictionary will
+have its reference count decremented if it was present.  It is not an
+error if the key did not previously exist.  The result of this
+procedure is TCL_OK, or TCL_ERROR if the \fIdictPtr\fR cannot be
+converted to a dictionary.
+.PP
+\fBTcl_DictObjSize\fR updates the given variable with the number of
+key/value pairs currently in the given dictionary.The result of this
+procedure is TCL_OK, or TCL_ERROR if the \fIdictPtr\fR cannot be
+converted to a dictionary.
+.PP
+\fBTcl_DictObjFirst\fR commences an iteration across all the key/value
+pairs in the given dictionary, placing the key and value in the
+variables pointed to by the \fIkeyPtrPtr\fR and \fIvaluePtrPtr\fR
+arguments (which may be NULL to indicate that the caller is
+uninterested in they key or variable respectively.)  The next
+key/value pair in the dictionary may be retrieved with
+\fBTcl_DictObjNext\fR.  Concurrent updates of the dictionary's
+internal representation will not modify the iteration processing
+unless the dictionary is unshared, when this will trigger premature
+termination of the iteration instead (which Tcl scripts cannot trigger
+via the \fBdict\fR command.)  The \fIsearchPtr\fR argument points to a
+piece of context that is used to identify which particular iteration
+is being performed, and is initialised by the call to
+\fBTcl_DictObjFirst\fR.  The \fIdonePtr\fR argument points to a
+variable that is updated to be zero of there are further key/value
+pairs to be iterated over, or non-zero if the iteration is complete.
+The order of iteration is implementation-defined.  If the
+\fIdictPtr\fR argument cannot be converted to a dictionary,
+\fBTcl_DictObjFirst\fR returns TCL_ERROR and the iteration is not
+commenced, and otherwise it returns TCL_OK.
+.PP
+If the last call to \fBTcl_DictObjFirst\fR or \fBTcl_DictObjNext\fR
+(for a particular \fIsearchPtr\fR) set the variable indicated by the
+\fIdonePtr\fR argument to zero but no further key/value pairs are
+desired from that particular iteration, the \fIsearchPtr\fR argument
+must be passed to \fBTcl_DictObjDone\fR to release any internal locks
+held by the searching process.  
+.PP
+The procedures \fBTcl_DictObjPutKeyList\fR and
+\fBTcl_DictObjRemoveKeyList\fR are the close analogues of
+\fBTcl_DictObjPut\fR and \fBTcl_DictObjRemove\fR respectively, except
+that instead of working with a single dictionary, they are designed to
+operate on a nested tree of dictionaries, with inner dictionaries
+stored as values inside outer dictionaries.  The \fIkeyc\fR and
+\fIkeyv\fR arguments specify a list of keys (with outermost keys
+first) that acts as a path to the key/value pair to be affected.  Note
+that there is no corresponding operation for reading a value for a
+path as this is easy to construct from repeated use of
+\fBTcl_DictObjGet\fR.
+
+'\" TODO: Example of using Tcl_DictObj{First,Next,Done}
+
+.SH "SEE ALSO"
+Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_InitObjHashTable
+
+.SH KEYWORDS
+dict, dict object, dictionary, hash table, iteration, object
+
diff --git a/doc/dict.n b/doc/dict.n
new file mode 100644
index 0000000..70c4db3
--- /dev/null
+++ b/doc/dict.n
@@ -0,0 +1,183 @@
+'\"
+'\" Copyright (c) 2003 Donal K. Fellows
+'\"
+'\" 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.1 2003/04/05 01:03:20 dkf Exp $
+'\"
+.so man.macros
+.TH dict n 8.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+dict \- Manipulate dictionaries.
+.SH SYNOPSIS
+\fBdict \fIoption arg \fR?\fIarg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Performs one of several operations on dictionary values or variables
+containing dictionary values, depending on \fIoption\fR.  The legal
+\fIoption\fRs (which may be abbreviated) are:
+.TP
+\fBdict append \fIdictionaryVariable key \fR?\fIstring ...\fR?
+This appends the given string (or strings) to the value that the given
+key maps to in the dictionary value contained in the given variable,
+writing the resulting dictionary value back to that variable.
+Non-existent keys are treated as if they map to an empty string.
+.TP
+\fBdict create \fR?\fIkey value ...\fR?
+Create a new dictionary that contains each of the key/value mappings
+listed as arguments (keys and values alternating, with each key being
+followed by its associated value.)
+.TP
+\fBdict exists \fIdictionaryValue key \fR?\fIkey ...\fR?
+This returns a boolean value indicating whether the given key (or path
+of keys through a set of nested dictionaries) exists in the given
+dictionary value. This returns a true value exactly when \fBdict
+get\fR on that path will succeed.
+.TP
+\fBdict filter \fIdictionaryValue filterType arg \fR?\fIarg ...\fR?
+This takes a dictionary value and returns a new dictionary that
+contains just those key/value pairs that match the specified filter
+type (which may be abbreviated.)  Supported filter types are:
+.RS
+.TP
+\fBdict filter \fIdictionaryValue \fBkey \fIglobPattern\fR
+The key rule only matches those key/value pairs whose keys match the
+given pattern (in the style of \fBstring match\fR.)
+.TP
+\fBdict filter \fIdictionaryValue \fBscript {\fIkeyVar valueVar\fB} \fIscript\fR
+The script rule tests for matching by assigning the key to the
+\fIkeyVar\fR and the value to the \fIvalueVar\fR, and then evaluating
+the given script which should return a boolean value (with the
+key/value pair only being included in the result of the \fBdict
+filter\fR when a true value is returned.)  Note that the first
+argument after the rule selection word is a two-element list.  If the
+\fIscript\fR returns with a condition of TCL_BREAK, no further
+key/value pairs are considered for inclusion in the resulting
+dictionary, and a condition of TCL_CONTINUE is equivalent to a false
+result.
+.TP
+\fBdict filter \fIdictionaryValue \fBvalue \fIglobPattern\fR
+The value rule only matches those key/value pairs whose values match
+the given pattern (in the style of \fBstring match\fR.)
+.RE
+.TP
+\fBdict for {\fIkeyVar valueVar\fB} \fIdictionaryValue body\fR
+This command takes three arguments, the first a two-element list of
+variable names (for the key and value respectively of each mapping in
+the dictionary), the second the dictionary value to iterate across,
+and the third a script to be evaluated for each mapping with the key
+and value variables set appropriately (in the manner of \fBforeach\fR.)
+The result of the command is an empty string. If any evaluation of the
+body generates a TCL_BREAK 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 TCL_CONTINUE result, this shall be treated exactly like a
+normal TCL_OK result.  The order of iteration is undefined.
+.TP
+\fBdict get \fIdictionaryValue \fR?\fIkey ...\fR?
+Given a dictionary value (first argument) and a key (second argument),
+this will retrieve the value for that key. Where several keys are
+supplied, the behaviour of the command shall be as if the result of
+\fBdict get $dictVal $key\fR was passed as the first argument to
+\fBdict get\fR with the remaining arguments as second (and possibly
+subsequent) arguments. This facilitates lookups in nested
+dictionaries. For example, the following two commands are equivalent:
+.RS
+.CS
+dict get $dict foo bar spong
+dict get [dict get [dict get $dict foo] bar] spong
+.CE
+If no keys are provided, dict would return a list containing pairs of
+elements in a manner similar to \fBarray get\fR. That is, the first
+element of each pair would be the key and the second element would be
+the value for that key.
+
+It is an error to attempt to retrieve a value for a key that is not
+present in the dictionary.
+.RE
+.TP
+\fBdict incr \fIdictionaryVariable key \fR?\fIincrement\fR?
+This adds the given increment value (an integer that defaults to 1 if
+not specified) to the value that the given key maps to in the
+dictionary value contained in the given variable, writing the
+resulting dictionary value back to that variable. Non-existent keys
+are treated as if they map to 0. It is an error to increment a value
+for an existing key if that value is not an integer.
+.TP
+\fBdict info \fIdictionaryValue\fR
+This returns information (intended for display to people) about the
+given dictionary though the format of this data is dependent on the
+implementation of the dictionary. For dictionaries that are
+implemented by hash tables, it is expected that this will return the
+string produced by \fBTcl_HashStats\fR, similar to \fBarray info\fR.
+.TP
+\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 i'th key returned by \fBdict keys\fR will be the key for
+the i'th value returned by \fBdict values\fR applied to the same
+dictionary value.
+.TP
+\fBdict lappend \fIdictionaryVariable key \fR?\fIvalue ...\fR?
+This appends the given items to the list value that the given key maps
+to in the dictionary value contained in the given variable, writing
+the resulting dictionary value back to that variable. Non-existent
+keys are treated as if they map to an empty list, and it is legal for
+there to be no items to append to the list. It is an error for the
+value that the key maps to to not be representable as a list.
+.TP
+\fBdict remove \fIdictionaryValue \fR?\fIkey ...\fR?
+Return a new dictionary that is a copy of an old one passed in as
+first argument except without mappings for each of the keys listed.
+It is legal for there to be no keys to remove, and it also legal for
+any of the keys to be removed to not be present in the input
+dictionary in the first place.
+.TP
+\fBdict replace \fIdictionaryValue \fR?\fIkey value ...\fR?
+Return a new dictionary that is a copy of an old one passed in as
+first argument except with some values different or some extra
+key/value pairs added. It is legal for this command to be called with
+no key/value pairs, but illegal for this command to be called with a
+key but no value.
+.TP
+\fBdict set \fIdictionaryVariable key \fR?\fIkey ...\fR? \fIvalue\fR
+This operation takes the name of a variable containing a dictionary
+value and places an updated dictionary value in that variable
+containing a mapping from the given key to the given value. In a
+manner analogous to \fBlset\fR, where multiple keys are present, they
+do indexing into nested dictionaries.
+.TP
+\fBdict size \fIdictionaryValue\fR
+Return the number of key/value mappings in the given dictionary value.
+.TP
+\fBdict unset \fIdictionaryVariable key \fR?\fIkey ...\fR?
+This operation (the companion to \fBdict set\fR) takes the name of a
+variable containing a dictionary value and places an updated
+dictionary value in that variable that does not contain a mapping for
+the given key. Where multiple keys are present, this describes a path
+through nested dictionaries to the mapping to remove. At least one key
+must be specified, but the last key on the key-path need not exist.
+All other components on the path must exist.
+.TP
+\fBdict values \fIdictionaryValue \fR?\fIglobPattern\fR?
+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 i'th key returned by \fBdict keys\fR will be
+the key for the i'th value returned by \fBdict values\fR applied to
+the same dictionary value.
+
+.SH "SEE ALSO"
+append(n), array(n), foreach(n), incr(n), list(n), lappend(n), set(n)
+
+.SH KEYWORDS
+dictionary, create, update, lookup, iterate, filter
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
new file mode 100644
index 0000000..c59be73
--- /dev/null
+++ b/generic/tclDictObj.c
@@ -0,0 +1,2558 @@
+/* 

+ * tclDictObj.c --

+ *

+ *	This file contains procedures that implement the Tcl dict object

+ *	type and its accessor command.

+ *

+ * Copyright (c) 2002 by Donal K. Fellows.

+ *

+ * 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.1 2003/04/05 01:03:20 dkf Exp $

+ */

+

+#include "tclInt.h"

+

+#if 0

+/*

+ * Declarations to go to tcl.h

+ */

+typedef struct {

+    Tcl_HashSearch search;

+    int epoch;

+    Dict *dictionaryPtr;

+} Tcl_DictSearch;

+/*

+ * Prototypes to be moved to tcl.decls...

+ */

+int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,

+	Tcl_Obj *keyPtr, Tcl_Obj *valuePtr);

+int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr,

+	Tcl_Obj **valuePtrPtr);

+int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);

+int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr);

+int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr,

+	Tcl_DictSearch *searchPtr,

+	Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr);

+void Tcl_DictObjNext(Tcl_DictSearch *searchPtr,

+	Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr);

+void Tcl_DictObjDone(Tcl_DictSearch *searchPtr);

+int Tcl_DictObjPutKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr,

+	int keyc, Tcl_Obj *CONST *keyv, Tcl_Obj *valuePtr);

+int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr,

+	int keyc, Tcl_Obj *CONST *keyv);

+Tcl_Obj *Tcl_NewDictObj(void);

+Tcl_Obj *Tcl_DbNewDictObj(CONST char *file, int line);

+/*

+ * Prototypes to be moved to tclInt.h

+ */

+int Tcl_DictObjCmd(ClientData clientData, Tcl_Interp *interp,

+	int objc, Tcl_Obj *CONST *objv);

+#endif

+

+/*----------------------------------------------------------------------*/

+

+/*

+ * Prototypes for procedures defined later in this file:

+ */

+

+static int		DictAppendCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictCreateCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictExistsCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictFilterCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictForCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictGetCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictInfoCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictKeysCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictLappendCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictRemoveCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictReplaceCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictSetCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictSizeCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictUnsetCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static int		DictValuesCmd _ANSI_ARGS_((Tcl_Interp *interp,

+			    int objc, Tcl_Obj *CONST *objv));

+static void		DupDictInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,

+			    Tcl_Obj *copyPtr));

+static void		FreeDictInternalRep _ANSI_ARGS_((Tcl_Obj *dictPtr));

+static int		SetDictFromAny _ANSI_ARGS_((Tcl_Interp *interp,

+			    Tcl_Obj *objPtr));

+static void		UpdateStringOfDict _ANSI_ARGS_((Tcl_Obj *dictPtr));

+static Tcl_Obj *	TraceDictPath _ANSI_ARGS_((Tcl_Interp *interp,

+			    Tcl_Obj *rootPtr, int keyc, Tcl_Obj *CONST keyv[],

+			    int willUpdate));

+struct Dict;

+static void		DeleteDict _ANSI_ARGS_((struct Dict *dict));

+

+/*

+ * Internal representation of a dictionary.

+ *

+ * The internal representation of a dictionary object is a hash table

+ * (with Tcl_Objs for both keys and values), a reference count and

+ * epoch number for detecting concurrent modifications of the

+ * dictionary, and a pointer to the parent object (used when

+ * invalidating string reps of pathed dictionary trees) which is NULL

+ * in normal use.  The fact that hash tables know (with appropriate

+ * initialisation) already about objects makes key management /so/

+ * much easier!

+ *

+ * Reference counts are used to enable safe iteration across hashes

+ * while allowing the type of the containing object to be modified.

+ */

+

+typedef struct Dict {

+    Tcl_HashTable table;

+    int epoch;

+    int refcount;

+    Tcl_Obj *chain;

+} Dict;

+

+/*

+ * The structure below defines the dictionary object type by means of

+ * procedures that can be invoked by generic object code.

+ */

+

+Tcl_ObjType tclDictType = {

+    "dict",

+    FreeDictInternalRep,		/* freeIntRepProc */

+    DupDictInternalRep,		        /* dupIntRepProc */

+    UpdateStringOfDict,			/* updateStringProc */

+    SetDictFromAny			/* setFromAnyProc */

+};

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DupDictInternalRep --

+ *

+ *	Initialize the internal representation of a dictionary Tcl_Obj

+ *	to a copy of the internal representation of an existing

+ *	dictionary object. 

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *	"srcPtr"s dictionary internal rep pointer should not be NULL and

+ *	we assume it is not NULL. We set "copyPtr"s internal rep to a

+ *	pointer to a newly allocated dictionary rep that, in turn, points

+ *	to "srcPtr"s key and value objects. Those objects are not

+ *	actually copied but are shared between "srcPtr" and "copyPtr".

+ *	The ref count of each key and value object is incremented.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static void

+DupDictInternalRep(srcPtr, copyPtr)

+    Tcl_Obj *srcPtr, *copyPtr;

+{

+    Dict *oldDict = (Dict *) srcPtr->internalRep.otherValuePtr;

+    Dict *newDict = (Dict *) ckalloc(sizeof(Dict));

+    Tcl_HashEntry *hPtr, *newHPtr;

+    Tcl_HashSearch search;

+    Tcl_Obj *keyPtr, *valuePtr;

+    int isNew;

+

+    /*

+     * 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);

+	Tcl_IncrRefCount(valuePtr);

+    }

+

+    /*

+     * Initialise other fields.

+     */

+    newDict->epoch = 0;

+    newDict->chain = NULL;

+    newDict->refcount = 1;

+

+    /*

+     * Store in the object.

+     */

+    copyPtr->internalRep.otherValuePtr = (VOID *) newDict;

+    copyPtr->typePtr = &tclDictType;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * FreeDictInternalRep --

+ *

+ *	Deallocate the storage associated with a dictionary object's

+ *	internal representation.

+ *

+ * Results:

+ *	None

+ *

+ * Side effects:

+ *	Frees the memory holding the dictionary's internal hash table.

+ *	Decrements the reference count of all key and value objects,

+ *	which may free them.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static void

+FreeDictInternalRep(dictPtr)

+    Tcl_Obj *dictPtr;

+{

+    Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr;

+

+    --dict->refcount;

+    if (dict->refcount == 0) {

+	DeleteDict(dict);

+    }

+

+    dictPtr->internalRep.otherValuePtr = NULL;	/* Belt and braces! */

+}

+

+static void

+DeleteDict(dict)

+    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);

+	Tcl_DecrRefCount(valuePtr);

+    }

+    Tcl_DeleteHashTable(&dict->table);

+    ckfree((char *) dict);

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * UpdateStringOfDict --

+ *

+ *	Update the string representation for a dictionary object.

+ *	Note: This procedure does not invalidate an existing old string

+ *	rep so storage will be lost if this has not already been done.

+ *	This code is based on UpdateStringOfList in tclListObj.c

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *	The object's string is set to a valid string that results from

+ *	the dict-to-string conversion. This string will be empty if the

+ *	dictionary has no key/value pairs. The dictionary internal

+ *	representation should not be NULL and we assume it is not NULL.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static void

+UpdateStringOfDict(dictPtr)

+    Tcl_Obj *dictPtr;

+{

+#define LOCAL_SIZE 20

+    int localFlags[LOCAL_SIZE], *flagPtr;

+    Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr;

+    Tcl_HashEntry *hPtr;

+    Tcl_HashSearch search;

+    Tcl_Obj *keyPtr, *valuePtr;

+    int numElems, i, length;

+    char *elem, *dst;

+

+    /*

+     * This field is the most useful one in the whole hash structure,

+     * and it is not exposed by any API function...

+     */

+    numElems = dict->table.numEntries * 2;

+

+    /*

+     * Pass 1: estimate space, gather flags.

+     */

+

+    if (numElems <= LOCAL_SIZE) {

+	flagPtr = localFlags;

+    } else {

+	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)) {

+	/*

+	 * Assume that hPtr is never NULL since we know the number of

+	 * array elements already.

+	 */

+

+	keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);

+	elem = Tcl_GetStringFromObj(keyPtr, &length);

+	dictPtr->length += Tcl_ScanCountedElement(elem, length,

+		&flagPtr[i]) + 1;

+

+	valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+	elem = Tcl_GetStringFromObj(valuePtr, &length);

+	dictPtr->length += Tcl_ScanCountedElement(elem, length,

+		&flagPtr[i+1]) + 1;

+    }

+

+    /*

+     * Pass 2: copy into string rep buffer.

+     */

+

+    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);

+	elem = Tcl_GetStringFromObj(keyPtr, &length);

+	dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);

+	*(dst++) = ' ';

+

+	valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+	elem = Tcl_GetStringFromObj(valuePtr, &length);

+	dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i+1]);

+	*(dst++) = ' ';

+    }

+    if (flagPtr != localFlags) {

+	ckfree((char *) flagPtr);

+    }

+    if (dst == dictPtr->bytes) {

+	*dst = 0;

+    } else {

+	*(--dst) = 0;

+    }

+    dictPtr->length = dst - dictPtr->bytes;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * SetDictFromAny --

+ *

+ *	Convert a non-dictionary object into a dictionary object.  This

+ *	code is very closely related to SetListFromAny in tclListObj.c

+ *	but does not actually guarantee that a dictionary object will

+ *	have a string rep (as conversions from lists are handled with a

+ *	special case.)

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	If the string can be converted, it loses any old internal

+ *	representation that it had and gains a dictionary's internalRep.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+SetDictFromAny(interp, objPtr)

+    Tcl_Interp *interp;

+    Tcl_Obj *objPtr;

+{

+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;

+    char *string, *s;

+    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 Tcl_Obj *keyPtr, *valuePtr;

+    Dict *dict;

+    Tcl_HashEntry *hPtr;

+    Tcl_HashSearch search;

+

+    /*

+     * Since lists and dictionaries have very closely-related string

+     * representations (i.e. the same parsing code) we can safely

+     * special-case the conversion from lists to dictionaries.

+     */

+

+    if (oldTypePtr == &tclListType) {

+	int objc, i;

+	Tcl_Obj **objv;

+

+	if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {

+	    return TCL_ERROR;

+	}

+	if (objc & 1) {

+	    if (interp != NULL) {

+		Tcl_SetObjResult(interp,

+			Tcl_NewStringObj("missing value to go with key", -1));

+	    }

+	    return TCL_ERROR;

+	}

+

+	/*

+	 * Build the hash of key/value pairs.

+	 */

+	dict = (Dict *) ckalloc(sizeof(Dict));

+	Tcl_InitObjHashTable(&dict->table);

+	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);

+	    if (!isNew) {

+		Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+		Tcl_DecrRefCount(discardedValue);

+	    }

+	    Tcl_SetHashValue(hPtr, (ClientData) objv[i+1]);

+	    Tcl_IncrRefCount(objv[i+1]); /* since hash now holds ref to it */

+	}

+

+	/*

+	 * Share type-setting code with the string-conversion case.

+	 */

+	goto installHash;

+    }

+

+    /*

+     * Get the string representation. Make it up-to-date if necessary.

+     */

+

+    string = Tcl_GetStringFromObj(objPtr, &length);

+    limit = (string + length);

+

+    /*

+     * Allocate a new HashTable that has objects for keys and objects

+     * for values.

+     */

+

+    dict = (Dict *) ckalloc(sizeof(Dict));

+    Tcl_InitObjHashTable(&dict->table);

+    for (p = string, lenRemain = length;

+	    lenRemain > 0;

+	    p = nextElem, lenRemain = (limit - nextElem)) {

+	result = TclFindElement(interp, p, lenRemain,

+		&elemStart, &nextElem, &elemSize, &hasBrace);

+	if (result != TCL_OK) {

+	    goto errorExit;

+	}

+	if (elemStart >= limit) {

+	    break;

+	}

+

+	/*

+	 * Allocate a Tcl object for the element and initialize it from the

+	 * "elemSize" bytes starting at "elemStart".

+	 */

+

+	s = ckalloc((unsigned) elemSize + 1);

+	if (hasBrace) {

+	    memcpy((VOID *) s, (VOID *) elemStart,  (size_t) elemSize);

+	    s[elemSize] = 0;

+	} else {

+	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);

+	}

+	

+	TclNewObj(keyPtr);

+        keyPtr->bytes  = s;

+        keyPtr->length = elemSize;

+

+	p = nextElem;

+	lenRemain = (limit - nextElem);

+	if (lenRemain <= 0) {

+	    goto missingKey;

+	}

+

+	result = TclFindElement(interp, p, lenRemain,

+		&elemStart, &nextElem, &elemSize, &hasBrace);

+	if (result != TCL_OK) {

+	    Tcl_DecrRefCount(keyPtr);

+	    goto errorExit;

+	}

+	if (elemStart >= limit) {

+	    goto missingKey;

+	}

+

+	/*

+	 * Allocate a Tcl object for the element and initialize it from the

+	 * "elemSize" bytes starting at "elemStart".

+	 */

+

+	s = ckalloc((unsigned) elemSize + 1);

+	if (hasBrace) {

+	    memcpy((VOID *) s, (VOID *) elemStart,  (size_t) elemSize);

+	    s[elemSize] = 0;

+	} else {

+	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);

+	}

+

+	TclNewObj(valuePtr);

+        valuePtr->bytes  = s;

+        valuePtr->length = elemSize;

+

+	/*

+	 * Store key and value in the hash table we're building.

+	 */

+	hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew);

+	if (!isNew) {

+	    Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+	    Tcl_DecrRefCount(keyPtr);

+	    Tcl_DecrRefCount(discardedValue);

+	}

+	Tcl_SetHashValue(hPtr, (ClientData) valuePtr);

+	Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */

+    }

+

+ installHash:

+    /*

+     * Free the old internalRep before setting the new one. We do this as

+     * late as possible to allow the conversion code, in particular

+     * Tcl_GetStringFromObj, to use that old internalRep.

+     */

+

+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {

+	oldTypePtr->freeIntRepProc(objPtr);

+    }

+

+    dict->epoch = 0;

+    dict->chain = NULL;

+    dict->refcount = 1;

+    objPtr->internalRep.otherValuePtr = (VOID *) dict;

+    objPtr->typePtr = &tclDictType;

+    return TCL_OK;

+

+ missingKey:

+    if (interp != NULL) {

+	Tcl_SetObjResult(interp,

+		Tcl_NewStringObj("missing value to go with key", -1));

+    }

+    Tcl_DecrRefCount(keyPtr);

+    result = TCL_ERROR;

+ errorExit:

+    for (hPtr=Tcl_FirstHashEntry(&dict->table,&search);

+	   hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {

+	valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+	Tcl_DecrRefCount(valuePtr);

+    }

+    Tcl_DeleteHashTable(&dict->table);

+    ckfree((char *) dict);

+    return result;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * TraceDictPath --

+ *

+ *	Trace through a tree of dictionaries using the array of keys

+ *	given. If the willUpdate flag is set, a backward-pointing chain

+ *	of dictionaries is also built (in the Dict's chain field) and

+ *	the chained dictionaries are made into unshared dictionaries (if

+ *	they aren't already.)

+ *

+ * Results:

+ *	The object at the end of the path, or NULL if there was an error.

+ *	Note that this it is an error for an intermediate dictionary on

+ *	the path to not exist.

+ *

+ * Side effects:

+ *	If the willUpdate flag is false, there are no side effects (other

+ *	than potential conversion of objects to dictionaries.)  If the

+ *	willUpdate flag is true, the following additional side effects

+ *	occur.  Shared dictionaries along the path are converted into

+ *	unshared objects, and a backward-pointing chain is built using

+ *	the chain fields of the dictionaries (for easy invalidation of

+ *	string representations.)

+ *

+ *----------------------------------------------------------------------

+ */

+

+static Tcl_Obj *

+TraceDictPath(interp, dictPtr, keyc, keyv, willUpdate)

+    Tcl_Interp *interp;

+    Tcl_Obj *dictPtr, *CONST keyv[];

+    int keyc, willUpdate;

+{

+    Dict *dict, *newDict;

+    int i;

+

+    if (dictPtr->typePtr != &tclDictType) {

+	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {

+	    return NULL;

+	}

+    }

+    dict = (Dict *) dictPtr->internalRep.otherValuePtr;

+    if (willUpdate) {

+	dict->chain = NULL;

+    }

+

+    for (i=0 ; i<keyc ; i++) {

+	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[i]);

+	Tcl_Obj *tmpObj;

+

+	if (hPtr == NULL) {

+	    if (interp != NULL) {

+		Tcl_ResetResult(interp);

+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

+			"key \"", TclGetString(keyv[i]),

+			"\" not known in dictionary", NULL);

+	    }

+	    return NULL;

+	}

+

+	tmpObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+	if (tmpObj->typePtr != &tclDictType) {

+	    if (SetDictFromAny(interp, tmpObj) != TCL_OK) {

+		return NULL;

+	    }

+	}

+	newDict = (Dict *) tmpObj->internalRep.otherValuePtr;

+	if (willUpdate) {

+	    if (Tcl_IsShared(tmpObj)) {

+		Tcl_DecrRefCount(tmpObj);

+		tmpObj = Tcl_DuplicateObj(tmpObj);

+		Tcl_SetHashValue(hPtr, (ClientData) tmpObj);

+		dict->epoch++;

+		newDict = (Dict *) tmpObj->internalRep.otherValuePtr;

+	    }

+

+	    newDict->chain = dictPtr;

+	}

+	dict = newDict;

+	dictPtr = tmpObj;

+    }

+    return dictPtr;

+}

+static void

+InvalidateDictChain(dictObj)

+    Tcl_Obj *dictObj;

+{

+    Dict *dict = (Dict *) dictObj->internalRep.otherValuePtr;

+

+    do {

+	if (dictObj->bytes != NULL) {

+	    Tcl_InvalidateStringRep(dictObj);

+	}

+	dict->epoch++;

+	if ((dictObj = dict->chain) == NULL) {

+	    break;

+	}

+	dict->chain = NULL;

+	dict = (Dict *) dictObj->internalRep.otherValuePtr;

+    } while (dict != NULL);

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DictObjPut --

+ *

+ *	Add a key,value pair to a dictionary, or update the value for a

+ *	key if that key already has a mapping in the dictionary.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	The object pointed to by dictPtr is converted to a dictionary if

+ *	it is not already one, and any string representation that it has

+ *	is invalidated.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr)

+    Tcl_Interp *interp;

+    Tcl_Obj *dictPtr, *keyPtr, *valuePtr;

+{

+    Dict *dict;

+    Tcl_HashEntry *hPtr;

+    int isNew;

+

+    if (Tcl_IsShared(dictPtr)) {

+	panic("Tcl_DictObjPut called with shared object");

+    }

+

+    if (dictPtr->typePtr != &tclDictType) {

+	int result = SetDictFromAny(interp, dictPtr);

+	if (result != TCL_OK) {

+	    return result;

+	}

+    }

+

+    if (dictPtr->bytes != NULL) {

+	Tcl_InvalidateStringRep(dictPtr);

+    }

+    dict = (Dict *) dictPtr->internalRep.otherValuePtr;

+    hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew);

+    Tcl_IncrRefCount(valuePtr);

+    if (!isNew) {

+	Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+	Tcl_DecrRefCount(oldValuePtr);

+    }

+    Tcl_SetHashValue(hPtr, valuePtr);

+    dict->epoch++;

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DictObjGet --

+ *

+ *	Given a key, get its value from the dictionary (or NULL if key

+ *	is not found in dictionary.)

+ *

+ * Results:

+ *	A standard Tcl result.  The variable pointed to by valuePtrPtr

+ *	is updated with the value for the key.  Note that it is not an

+ *	error for the key to have no mapping in the dictionary.

+ *

+ * Side effects:

+ *	The object pointed to by dictPtr is converted to a dictionary if

+ *	it is not already one.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+Tcl_DictObjGet(interp, dictPtr, keyPtr, valuePtrPtr)

+    Tcl_Interp *interp;

+    Tcl_Obj *dictPtr, *keyPtr, **valuePtrPtr;

+{

+    Dict *dict;

+    Tcl_HashEntry *hPtr;

+

+    if (dictPtr->typePtr != &tclDictType) {

+	int result = SetDictFromAny(interp, dictPtr);

+	if (result != TCL_OK) {

+	    return result;

+	}

+    }

+

+    dict = (Dict *) dictPtr->internalRep.otherValuePtr;

+    hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyPtr);

+    if (hPtr == NULL) {

+	*valuePtrPtr = NULL;

+    } else {

+	*valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+    }

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DictObjRemove --

+ *

+ *	Remove the key,value pair with the given key from the dictionary;

+ *	the key does not need to be present in the dictionary.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	The object pointed to by dictPtr is converted to a dictionary if

+ *	it is not already one, and any string representation that it has

+ *	is invalidated.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+Tcl_DictObjRemove(interp, dictPtr, keyPtr)

+    Tcl_Interp *interp;

+    Tcl_Obj *dictPtr, *keyPtr;

+{

+    Dict *dict;

+    Tcl_HashEntry *hPtr;

+

+    if (Tcl_IsShared(dictPtr)) {

+	panic("Tcl_DictObjRemove called with shared object");

+    }

+

+    if (dictPtr->typePtr != &tclDictType) {

+	int result = SetDictFromAny(interp, dictPtr);

+	if (result != TCL_OK) {

+	    return result;

+	}

+    }

+

+    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);

+

+	Tcl_DecrRefCount(valuePtr);

+	Tcl_DeleteHashEntry(hPtr);

+	dict->epoch++;

+    }

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DictObjSize --

+ *

+ *	How many key,value pairs are there in the dictionary?

+ *

+ * Results:

+ *	A standard Tcl result.  Updates the variable pointed to by

+ *	sizePtr with the number of key,value pairs in the dictionary.

+ *

+ * Side effects:

+ *	The dictPtr object is converted to a dictionary type if it is

+ *	not a dictionary already.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+Tcl_DictObjSize(interp, dictPtr, sizePtr)

+    Tcl_Interp *interp;

+    Tcl_Obj *dictPtr;

+    int *sizePtr;

+{

+    Dict *dict;

+

+    if (dictPtr->typePtr != &tclDictType) {

+	int result = SetDictFromAny(interp, dictPtr);

+	if (result != TCL_OK) {

+	    return result;

+	}

+    }

+

+    dict = (Dict *) dictPtr->internalRep.otherValuePtr;

+    *sizePtr = dict->table.numEntries;

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DictObjFirst --

+ *

+ *	Start a traversal of the dictionary.  Caller must supply the

+ *	search context, pointers for returning key and value, and a

+ *	pointer to allow indication of whether the dictionary has been

+ *	traversed (i.e. the dictionary is empty.) The order of traversal

+ *	is undefined.

+ *

+ * Results:

+ *	A standard Tcl result.  Updates the variables pointed to by

+ *	keyPtrPtr, valuePtrPtr and donePtr.  Either of keyPtrPtr and

+ *	valuePtrPtr may be NULL, in which case the key/value is not made

+ *	available to the caller.

+ *

+ * Side effects:

+ *	The dictPtr object is converted to a dictionary type if it is

+ *	not a dictionary already.  The search context is initialised if

+ *	the search has not finished.  The dictionary's internal rep is

+ *	Tcl_Preserve()d if the dictionary has at least one element.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+Tcl_DictObjFirst(interp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr)

+    Tcl_Interp *interp;			/* For error messages, or NULL if no

+					 * error messages desired. */

+    Tcl_Obj *dictPtr;			/* Dictionary to traverse. */

+    Tcl_DictSearch *searchPtr;		/* Pointer to a dict search context. */

+    Tcl_Obj **keyPtrPtr;		/* Pointer to a variable to have the

+					 * first key written into, or NULL. */

+    Tcl_Obj **valuePtrPtr;		/* Pointer to a variable to have the

+					 * first value written into, or NULL.*/

+    int *donePtr;			/* Pointer to a variable which will

+					 * have a 1 written into when there

+					 * are no further values in the

+					 * dictionary, or a 0 otherwise. */

+{

+    Dict *dict;

+    Tcl_HashEntry *hPtr;

+

+    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) {

+	*donePtr = 1;

+    } else {

+	*donePtr = 0;

+	searchPtr->dictionaryPtr = (Tcl_Dict) dict;

+	searchPtr->epoch = dict->epoch;

+	dict->refcount++;

+	if (keyPtrPtr != NULL) {

+	    *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);

+	}

+	if (valuePtrPtr != NULL) {

+	    *valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+	}

+    }

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DictObjNext --

+ *

+ *	Continue a traversal of a dictionary previously started with

+ *	Tcl_DictObjFirst.  This function is safe against concurrent

+ *	modification of the underlying object (including type

+ *	shimmering), treating such situations as if the search has

+ *	terminated, though it is up to the caller to ensure that the

+ *	object itself is not disposed until the search has finished.

+ *	It is _not_ safe against modifications from other threads.

+ *

+ * Results:

+ *	Updates the variables pointed to by keyPtrPtr, valuePtrPtr and

+ *	donePtr.  Either of keyPtrPtr and valuePtrPtr may be NULL, in

+ *	which case the key/value is not made available to the caller.

+ *

+ * Side effects:

+ *	Removes a reference to the dictionary's internal rep if the

+ *	search terminates.

+ *

+ *----------------------------------------------------------------------

+ */

+

+void

+Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr)

+    Tcl_DictSearch *searchPtr;		/* Pointer to a hash search context. */

+    Tcl_Obj **keyPtrPtr;		/* Pointer to a variable to have the

+					 * first key written into, or NULL. */

+    Tcl_Obj **valuePtrPtr;		/* Pointer to a variable to have the

+					 * first value written into, or NULL.*/

+    int *donePtr;			/* Pointer to a variable which will

+					 * have a 1 written into when there

+					 * are no further values in the

+					 * dictionary, or a 0 otherwise. */

+{

+    Tcl_HashEntry *hPtr;

+

+    /*

+     * Bail out if the dictionary has had any elements added, modified

+     * or removed.  This *shouldn't* happen, but...

+     */

+    if (((Dict *)searchPtr->dictionaryPtr)->epoch != searchPtr->epoch) {

+	panic("concurrent dictionary modification and search");

+    }

+

+    hPtr = Tcl_NextHashEntry(&searchPtr->search);

+    if (hPtr == NULL) {

+	Tcl_DictObjDone(searchPtr);

+	*donePtr = 1;

+	return;

+    }

+

+    *donePtr = 0;

+    if (keyPtrPtr != NULL) {

+	*keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(

+		&((Dict *)searchPtr->dictionaryPtr)->table, hPtr);

+    }

+    if (valuePtrPtr != NULL) {

+	*valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+    }

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DictObjDone --

+ *

+ *	Call this if you want to stop a search before you reach the

+ *	end of the dictionary (e.g. because of abnormal termination of

+ *	the search.)  It should not be used if the search reaches its

+ *	natural end (i.e. if either Tcl_DictObjFirst or Tcl_DictObjNext

+ *	sets its donePtr variable to 1.)

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *	Removes a reference to the dictionary's internal rep.

+ *

+ *----------------------------------------------------------------------

+ */

+

+void

+Tcl_DictObjDone(searchPtr)

+    Tcl_DictSearch *searchPtr;		/* Pointer to a hash search context. */

+{

+    Dict *dict;

+

+    if (searchPtr->epoch != -1) {

+	searchPtr->epoch = -1;

+	dict = (Dict *) searchPtr->dictionaryPtr;

+	dict->refcount--;

+	if (dict->refcount == 0) {

+	    DeleteDict(dict);

+	}

+    }

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DictObjRemoveKeyList --

+ *

+ *	Add a key...key,value pair to a dictionary tree.  The main

+ *	dictionary value must not be shared, though sub-dictionaries may

+ *	be.  All intermediate dictionaries on the path must exist.

+ *

+ * Results:

+ *	A standard Tcl result.  Note that in the error case, a message

+ *	is left in interp unless that is NULL.

+ *

+ * Side effects:

+ *	If the dictionary and any of its sub-dictionaries on the

+ *	path have string representations, these are invalidated.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr)

+    Tcl_Interp *interp;

+    int keyc;

+    Tcl_Obj *dictPtr, *CONST keyv[], *valuePtr;

+{

+    Dict *dict;

+    Tcl_HashEntry *hPtr;

+    int isNew;

+

+    if (Tcl_IsShared(dictPtr)) {

+	panic("Tcl_DictObjPutKeyList called with shared object");

+    }

+    if (keyc < 1) {

+	panic("Tcl_DictObjPutKeyList called with empty key list");

+    }

+

+    dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, /*willUpdate*/ 1);

+    if (dictPtr == NULL) {

+	return TCL_ERROR;

+    }

+

+    dict = (Dict *) dictPtr->internalRep.otherValuePtr;

+    hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyv[keyc-1], &isNew);

+    Tcl_IncrRefCount(valuePtr);

+    if (!isNew) {

+	Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

+	Tcl_DecrRefCount(oldValuePtr);

+    }

+    Tcl_SetHashValue(hPtr, valuePtr);

+    InvalidateDictChain(dictPtr);

+

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DictObjRemoveKeyList --

+ *

+ *	Remove a key...key,value pair from a dictionary tree (the value

+ *	removed is implicit in the key path.)  The main dictionary value

+ *	must not be shared, though sub-dictionaries may be.  It is not

+ *	an error if there is no value associated with the given key list,

+ *	but all intermediate dictionaries on the key path must exist.

+ *

+ * Results:

+ *	A standard Tcl result.  Note that in the error case, a message

+ *	is left in interp unless that is NULL.

+ *

+ * Side effects:

+ *	If the dictionary and any of its sub-dictionaries on the key

+ *	path have string representations, these are invalidated.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv)

+    Tcl_Interp *interp;

+    int keyc;

+    Tcl_Obj *dictPtr, *CONST keyv[];

+{

+    Dict *dict;

+    Tcl_HashEntry *hPtr;

+

+    if (Tcl_IsShared(dictPtr)) {

+	panic("Tcl_DictObjRemoveKeyList called with shared object");

+    }

+    if (keyc < 1) {

+	panic("Tcl_DictObjRemoveKeyList called with empty key list");

+    }

+

+    dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, /*willUpdate*/ 1);

+    if (dictPtr == NULL) {

+	return TCL_ERROR;

+    }

+

+    dict = (Dict *) dictPtr->internalRep.otherValuePtr;

+    hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[keyc-1]);

+    if (hPtr != NULL) {

+	Tcl_DeleteHashEntry(hPtr);

+    }

+    InvalidateDictChain(dictPtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_NewListObj --

+ *

+ *	This procedure is normally called when not debugging: i.e., when

+ *	TCL_MEM_DEBUG is not defined. It creates a new dict object

+ *	without any content.

+ *

+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the

+ *	result of calling the debugging version Tcl_DbNewDictObj.

+ *

+ * Results:

+ *	A new dict object is returned; it has no keys defined in it.

+ *	The new object's string representation is left NULL, and the

+ *	ref count of the object is 0.

+ *

+ * Side Effects:

+ *	None.

+ *

+ *----------------------------------------------------------------------

+ */

+

+Tcl_Obj *

+Tcl_NewDictObj()

+{

+#ifdef TCL_MEM_DEBUG

+    return Tcl_DbNewDictObj("unknown", 0);

+#else /* !TCL_MEM_DEBUG */

+    Tcl_Obj *dictPtr;

+    Dict *dict;

+

+    TclNewObj(dictPtr);

+    Tcl_InvalidateStringRep(dictPtr);

+    dict = (Dict *) ckalloc(sizeof(Dict));

+    Tcl_InitObjHashTable(&dict->table);

+    dict->epoch = 0;

+    dict->chain = NULL;

+    dictPtr->internalRep.otherValuePtr = (VOID *) dict;

+    dictPtr->typePtr = &tclDictType;

+    return dictPtr;

+#endif

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DbNewListObj --

+ *

+ *	This procedure is normally called when debugging: i.e., when

+ *	TCL_MEM_DEBUG is defined. It creates new dict objects. It is the

+ *	same as the Tcl_NewDictObj procedure above except that it calls

+ *	Tcl_DbCkalloc directly with the file name and line number from its

+ *	caller. This simplifies debugging since then the [memory active]

+ *	command	will report the correct file name and line number when

+ *	reporting objects that haven't been freed.

+ *

+ *	When TCL_MEM_DEBUG is not defined, this procedure just returns the

+ *	result of calling Tcl_NewDictObj.

+ *

+ * Results:

+ *	A new dict object is returned; it has no keys defined in it.

+ *	The new object's string representation is left NULL, and the

+ *	ref count of the object is 0.

+ *

+ * Side Effects:

+ *	None.

+ *

+ *----------------------------------------------------------------------

+ */

+

+Tcl_Obj *

+Tcl_DbNewDictObj(file, line)

+    CONST char *file;

+    int line;

+{

+#ifdef TCL_MEM_DEBUG

+    Tcl_Obj *dictPtr;

+    Dict *dict;

+

+    TclDbNewObj(dictPtr, file, line);

+    Tcl_InvalidateStringRep(dictPtr);

+    dict = (Dict *) ckalloc(sizeof(Dict));

+    Tcl_InitObjHashTable(&dict->table);

+    dict->epoch = 0;

+    dict->chain = NULL;

+    dictPtr->internalRep.otherValuePtr = (VOID *) dict;

+    dictPtr->typePtr = &tclDictType;

+    return dictPtr;

+#else /* !TCL_MEM_DEBUG */

+    return Tcl_NewDictObj();

+#endif

+}

+

+/***** START OF FUNCTIONS IMPLEMENTING TCL COMMANDS *****/

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictCreateCmd --

+ *

+ *	This function implements the "dict create" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictCreateCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictObj;

+    int i;

+

+    /*

+     * Must have an even number of arguments; note that number of

+     * preceding arguments (i.e. "dict create" is also even, which

+     * makes this much easier.)

+     */

+    if (objc & 1) {

+	Tcl_WrongNumArgs(interp, 2, objv, "?key value ...?");

+	return TCL_ERROR;

+    }

+

+    dictObj = Tcl_NewDictObj();

+    for (i=2 ; i<objc ; i+=2) {

+	/*

+	 * The next command is assumed to never fail...

+	 */

+	Tcl_DictObjPut(interp, dictObj, objv[i], objv[i+1]);

+    }

+    Tcl_SetObjResult(interp, dictObj);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictGetCmd --

+ *

+ *	This function implements the "dict get" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictGetCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictPtr, *valuePtr = NULL;

+    int result;

+

+    if (objc < 3) {

+	Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key key ...?");

+	return TCL_ERROR;

+    }

+

+    /*

+     * Test for the special case of no keys, which returns a *list* of

+     * all key,value pairs.  We produce a copy here because that makes

+     * subsequent list handling more efficient.

+     */

+

+    if (objc == 3) {

+	Tcl_Obj *keyPtr, *listPtr;

+	Tcl_DictSearch search;

+	int done;

+

+	result = Tcl_DictObjFirst(interp, objv[2], &search,

+		&keyPtr, &valuePtr, &done);

+	if (result != TCL_OK) {

+	    return result;

+	}

+	listPtr = Tcl_NewListObj(0, NULL);

+	while (!done) {

+	    /*

+	     * Assume these won't fail as we have complete control

+	     * over the types of things here.

+	     */

+

+	    Tcl_ListObjAppendElement(interp, listPtr, keyPtr);

+	    Tcl_ListObjAppendElement(interp, listPtr, valuePtr);

+

+	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);

+	}

+	Tcl_SetObjResult(interp, listPtr);

+	return TCL_OK;

+    }

+

+    /*

+     * Loop through the list of keys, looking up the key at the

+     * current index in the current dictionary each time.  Once we've

+     * done the lookup, we set the current dictionary to be the value

+     * we looked up (in case the value was not the last one and we are

+     * going through a chain of searches.)  Note that this loop always

+     * executes at least once.

+     */

+    dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, /*willUpdate*/ 0);

+    if (dictPtr == NULL) {

+	return TCL_ERROR;

+    }

+    result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);

+    if (result != TCL_OK) {

+	return result;

+    }

+    if (valuePtr == NULL) {

+	Tcl_ResetResult(interp);

+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

+		"key \"", TclGetString(objv[objc-1]),

+		"\" not known in dictionary", NULL);

+	return TCL_ERROR;

+    }

+    Tcl_SetObjResult(interp, valuePtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictReplaceCmd --

+ *

+ *	This function implements the "dict replace" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictReplaceCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictPtr;

+    int i, result;

+

+    if ((objc < 3) || !(objc & 1)) {

+	Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key value ...?");

+	return TCL_ERROR;

+    }

+

+    dictPtr = objv[2];

+    if (Tcl_IsShared(dictPtr)) {

+	dictPtr = Tcl_DuplicateObj(dictPtr);

+    }

+    for (i=3 ; i<objc ; i+=2) {

+	result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);

+	if (result != TCL_OK) {

+	    return TCL_ERROR;

+	}

+    }

+    Tcl_SetObjResult(interp, dictPtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictRemoveCmd --

+ *

+ *	This function implements the "dict remove" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictRemoveCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictPtr;

+    int i, result;

+

+    if (objc < 3) {

+	Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?key ...?");

+	return TCL_ERROR;

+    }

+

+    dictPtr = objv[2];

+    if (Tcl_IsShared(dictPtr)) {

+	dictPtr = Tcl_DuplicateObj(dictPtr);

+    }

+    for (i=3 ; i<objc ; i++) {

+	result = Tcl_DictObjRemove(interp, dictPtr, objv[i]);

+	if (result != TCL_OK) {

+	    return TCL_ERROR;

+	}

+    }

+    Tcl_SetObjResult(interp, dictPtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictKeysCmd --

+ *

+ *	This function implements the "dict keys" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictKeysCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *keyPtr, *listPtr;

+    Tcl_DictSearch search;

+    int result, done;

+    char *pattern = NULL;

+

+    if (objc!=3 && objc!=4) {

+	Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?pattern?");

+	return TCL_ERROR;

+    }

+

+    result = Tcl_DictObjFirst(interp, objv[2], &search, &keyPtr, NULL, &done);

+    if (result != TCL_OK) {

+	return TCL_ERROR;

+    }

+    if (objc == 4) {

+	pattern = TclGetString(objv[3]);

+    }

+    listPtr = Tcl_NewListObj(0, NULL);

+    for (; !done ; Tcl_DictObjNext(&search, &keyPtr, NULL, &done)) {

+	if (pattern==NULL || Tcl_StringMatch(TclGetString(keyPtr), pattern)) {

+	    /*

+	     * Assume this operation always succeeds.

+	     */

+	    Tcl_ListObjAppendElement(interp, listPtr, keyPtr);

+	}

+    }

+    Tcl_SetObjResult(interp, listPtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictValuesCmd --

+ *

+ *	This function implements the "dict values" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictValuesCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *valuePtr, *listPtr;

+    Tcl_DictSearch search;

+    int result, done;

+    char *pattern = NULL;

+

+    if (objc!=3 && objc!=4) {

+	Tcl_WrongNumArgs(interp, 2, objv, "dictionary ?pattern?");

+	return TCL_ERROR;

+    }

+

+    result= Tcl_DictObjFirst(interp, objv[2], &search, NULL, &valuePtr, &done);

+    if (result != TCL_OK) {

+	return TCL_ERROR;

+    }

+    if (objc == 4) {

+	pattern = TclGetString(objv[3]);

+    }

+    listPtr = Tcl_NewListObj(0, NULL);

+    for (; !done ; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) {

+	if (pattern==NULL || Tcl_StringMatch(TclGetString(valuePtr),pattern)) {

+	    /*

+	     * Assume this operation always succeeds.

+	     */

+	    Tcl_ListObjAppendElement(interp, listPtr, valuePtr);

+	}

+    }

+    Tcl_SetObjResult(interp, listPtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictSizeCmd --

+ *

+ *	This function implements the "dict size" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictSizeCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    int result, size;

+

+    if (objc != 3) {

+	Tcl_WrongNumArgs(interp, 2, objv, "dictionary");

+	return TCL_ERROR;

+    }

+    result = Tcl_DictObjSize(interp, objv[2], &size);

+    if (result == TCL_OK) {

+	Tcl_SetObjResult(interp, Tcl_NewIntObj(size));

+    }

+    return result;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictExistsCmd --

+ *

+ *	This function implements the "dict exists" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictExistsCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictPtr, *valuePtr;

+    int result;

+

+    if (objc < 4) {

+	Tcl_WrongNumArgs(interp, 2, objv, "dictionary key ?key ...?");

+	return TCL_ERROR;

+    }

+

+    dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, /*willUpdate*/ 0);

+    if (dictPtr == NULL) {

+	return TCL_ERROR;

+    }

+    result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);

+    if (result != TCL_OK) {

+	return result;

+    }

+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictInfoCmd --

+ *

+ *	This function implements the "dict info" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictInfoCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictPtr;

+    Dict *dict;

+

+    if (objc != 3) {

+	Tcl_WrongNumArgs(interp, 2, objv, "dictionary");

+	return TCL_ERROR;

+    }

+

+    dictPtr = objv[2];

+    if (dictPtr->typePtr != &tclDictType) {

+	int result = SetDictFromAny(interp, dictPtr);

+	if (result != TCL_OK) {

+	    return result;

+	}

+    }

+    dict = (Dict *)dictPtr->internalRep.otherValuePtr;

+    Tcl_SetObjResult(interp,

+	    Tcl_NewStringObj(Tcl_HashStats(&dict->table), -1));

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictIncrCmd --

+ *

+ *	This function implements the "dict incr" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictIncrCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;

+    int result, incrValue;

+

+    if (objc < 4 || objc > 5) {

+	Tcl_WrongNumArgs(interp, 2, objv, "varName key ?increment?");

+	return TCL_ERROR;

+    }

+

+    if (objc == 5) {

+	result = Tcl_GetIntFromObj(interp, objv[4], &incrValue);

+	if (result != TCL_OK) {

+	    return result;

+	}

+    } else {

+	incrValue = 1;

+    }

+

+    dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);

+    if (dictPtr == NULL) {

+	dictPtr = Tcl_NewDictObj();

+	Tcl_DictObjPut(interp, dictPtr, objv[3], Tcl_NewIntObj(incrValue));

+    } else {

+	int iValue;

+	Tcl_WideInt wValue;

+

+	if (Tcl_IsShared(dictPtr)) {

+	    dictPtr = Tcl_DuplicateObj(dictPtr);

+	}

+

+	if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) {

+	    return TCL_ERROR;

+	}

+	if (valuePtr == NULL) {

+	    valuePtr = Tcl_NewIntObj(incrValue);

+	} else if (valuePtr->typePtr == &tclWideIntType) {

+	    Tcl_GetWideIntFromObj(NULL, valuePtr, &wValue);

+	    if (Tcl_IsShared(valuePtr)) {

+		valuePtr = Tcl_NewWideIntObj(wValue + incrValue);

+	    } else {

+		Tcl_SetWideIntObj(valuePtr, wValue + incrValue);

+		if (dictPtr->bytes != NULL) {

+		    Tcl_InvalidateStringRep(dictPtr);

+		}

+		goto valueAlreadyInDictionary;

+	    }

+	} else if (valuePtr->typePtr == &tclIntType) {

+	    Tcl_GetIntFromObj(NULL, valuePtr, &iValue);

+	    if (Tcl_IsShared(valuePtr)) {

+		valuePtr = Tcl_NewIntObj(iValue + incrValue);

+	    } else {

+		Tcl_SetIntObj(valuePtr, iValue + incrValue);

+		if (dictPtr->bytes != NULL) {

+		    Tcl_InvalidateStringRep(dictPtr);

+		}

+		goto valueAlreadyInDictionary;

+	    }

+	} else {

+	    result = Tcl_GetWideIntFromObj(interp, valuePtr, &wValue);

+	    if (result != TCL_OK) {

+		return result;

+	    }

+	    /*

+	     * Determine if we should have got a standard int instead.

+	     */

+	    if (Tcl_IsShared(valuePtr)) {

+		if (wValue >= INT_MIN && wValue <= INT_MAX) {

+		    /*

+		     * Convert the type...

+		     */

+		    Tcl_GetIntFromObj(NULL, valuePtr, &iValue);

+		    valuePtr = Tcl_NewIntObj(iValue + incrValue);

+		} else {

+		    valuePtr = Tcl_NewWideIntObj(wValue + incrValue);

+		}

+	    } else {

+		if (wValue >= INT_MIN && wValue <= INT_MAX) {

+		    Tcl_SetIntObj(valuePtr,

+			    Tcl_WideAsLong(wValue) + incrValue);

+		} else {

+		    Tcl_SetWideIntObj(valuePtr, wValue + incrValue);

+		}

+		if (dictPtr->bytes != NULL) {

+		    Tcl_InvalidateStringRep(dictPtr);

+		}

+		goto valueAlreadyInDictionary;

+	    }

+	}

+	if (Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr) != TCL_OK) {

+	    Tcl_DecrRefCount(valuePtr);

+	    return TCL_ERROR;

+	}

+	valueAlreadyInDictionary:

+    }

+    resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,

+	    TCL_LEAVE_ERR_MSG);

+    if (resultPtr == NULL) {

+	Tcl_DecrRefCount(dictPtr);

+	return TCL_ERROR;

+    }

+    Tcl_SetObjResult(interp, resultPtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictLappendCmd --

+ *

+ *	This function implements the "dict lappend" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictLappendCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;

+    int i, allocatedDict = 0, allocatedValue = 0;

+

+    if (objc < 4) {

+	Tcl_WrongNumArgs(interp, 2, objv, "varName key ?value ...?");

+	return TCL_ERROR;

+    }

+

+    dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);

+    if (dictPtr == NULL) {

+	allocatedDict = 1;

+	dictPtr = Tcl_NewDictObj();

+    } else 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) {

+	valuePtr = Tcl_NewListObj(objc-4, objv+4);

+	allocatedValue = 1;

+    } else {

+	if (Tcl_IsShared(valuePtr)) {

+	    allocatedValue = 1;

+	    valuePtr = Tcl_DuplicateObj(valuePtr);

+	}

+

+	for (i=4 ; i<objc ; i++) {

+	    if (Tcl_ListObjAppendElement(interp, valuePtr,

+		    objv[i]) != TCL_OK) {

+		if (allocatedValue) {

+		    Tcl_DecrRefCount(valuePtr);

+		}

+		if (allocatedDict) {

+		    Tcl_DecrRefCount(dictPtr);

+		}

+		return TCL_ERROR;

+	    }

+	}

+    }

+

+    if (allocatedValue) {

+	Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr);

+    } else if (dictPtr->bytes != NULL) {

+	Tcl_InvalidateStringRep(dictPtr);

+    }

+

+    resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,

+	    TCL_LEAVE_ERR_MSG);

+    if (resultPtr == NULL) {

+	if (allocatedDict) {

+	    Tcl_DecrRefCount(dictPtr);

+	}

+	return TCL_ERROR;

+    }

+    Tcl_SetObjResult(interp, resultPtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictAppendCmd --

+ *

+ *	This function implements the "dict append" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictAppendCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;

+    int i, allocatedDict = 0;

+

+    if (objc < 4) {

+	Tcl_WrongNumArgs(interp, 2, objv, "varName key ?value ...?");

+	return TCL_ERROR;

+    }

+

+    dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);

+    if (dictPtr == NULL) {

+	allocatedDict = 1;

+	dictPtr = Tcl_NewDictObj();

+    } else 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) {

+	TclNewObj(valuePtr);

+    } else {

+	if (Tcl_IsShared(valuePtr)) {

+	    valuePtr = Tcl_DuplicateObj(valuePtr);

+	}

+    }

+

+    for (i=4 ; i<objc ; i++) {

+	Tcl_AppendObjToObj(valuePtr, objv[i]);

+    }

+

+    Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr);

+

+    resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,

+	    TCL_LEAVE_ERR_MSG);

+    if (resultPtr == NULL) {

+	if (allocatedDict) {

+	    Tcl_DecrRefCount(dictPtr);

+	}

+	return TCL_ERROR;

+    }

+    Tcl_SetObjResult(interp, resultPtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictForCmd --

+ *

+ *	This function implements the "dict for" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictForCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictObj, *scriptObj, *keyVarObj, *valueVarObj;

+    Tcl_Obj **varv, *keyObj, *valueObj;

+    Tcl_DictSearch search;

+    int varc, done, result;

+

+    if (objc != 5) {

+	Tcl_WrongNumArgs(interp, 2, objv,

+		"{keyVar valueVar} dictionary script");

+	return TCL_ERROR;

+    }

+

+    if (Tcl_ListObjGetElements(interp, objv[2], &varc, &varv) != TCL_OK) {

+	return TCL_ERROR;

+    }

+    if (varc != 2) {

+	Tcl_ResetResult(interp);

+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

+		"must have exactly two variable names", NULL);

+	return TCL_ERROR;

+    }

+    keyVarObj = varv[0];

+    valueVarObj = varv[1];

+    dictObj = objv[3];

+    scriptObj = objv[4];

+    /*

+     * Make sure that these objects (which we need throughout the body

+     * of the loop) don't vanish.  Note that we also care that the

+     * dictObj remains a dictionary, which requires slightly more

+     * elaborate precautions.  That we achieve by making sure that the

+     * type is static throughout and that the hash is the same hash

+     * throughout; taking a copy of the whole thing would be easier,

+     * but much less efficient.

+     */

+    Tcl_IncrRefCount(keyVarObj);

+    Tcl_IncrRefCount(valueVarObj);

+    Tcl_IncrRefCount(dictObj);

+    Tcl_IncrRefCount(scriptObj);

+

+    result = Tcl_DictObjFirst(interp, dictObj,

+	    &search, &keyObj, &valueObj, &done);

+    if (result != TCL_OK) {

+	Tcl_DecrRefCount(keyVarObj);

+	Tcl_DecrRefCount(valueVarObj);

+	Tcl_DecrRefCount(dictObj);

+	Tcl_DecrRefCount(scriptObj);

+	return TCL_ERROR;

+    }

+

+    while (!done) {

+	/*

+	 * Stop the value from getting hit in any way by any traces on

+	 * the key variable.

+	 */

+	Tcl_IncrRefCount(valueObj);

+	if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,

+		TCL_LEAVE_ERR_MSG) == NULL) {

+	    Tcl_ResetResult(interp);

+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

+		    "couldn't set key variable: \"",

+		    Tcl_GetString(keyVarObj), "\"", (char *) NULL);

+	    Tcl_DecrRefCount(valueObj);

+	errorExit:

+	    Tcl_DictObjDone(&search);

+	    Tcl_DecrRefCount(keyVarObj);

+	    Tcl_DecrRefCount(valueVarObj);

+	    Tcl_DecrRefCount(dictObj);

+	    Tcl_DecrRefCount(scriptObj);

+	    return TCL_ERROR;

+	}

+	Tcl_DecrRefCount(valueObj);

+	if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,

+		TCL_LEAVE_ERR_MSG) == NULL) {

+	    Tcl_ResetResult(interp);

+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

+		    "couldn't set value variable: \"",

+		    Tcl_GetString(keyVarObj), "\"", (char *) NULL);

+	    goto errorExit;

+	}

+

+	result = Tcl_EvalObjEx(interp, scriptObj, 0);

+	if (result != TCL_OK) {

+	    if (result == TCL_CONTINUE) {

+		result = TCL_OK;

+	    } else if (result == TCL_BREAK) {

+		result = TCL_OK;

+		Tcl_DictObjDone(&search);

+		break;

+	    } else if (result == TCL_ERROR) {

+                char msg[32 + TCL_INTEGER_SPACE];

+

+		sprintf(msg, "\n    (\"dict for\" body line %d)",

+			interp->errorLine);

+		Tcl_AddObjErrorInfo(interp, msg, -1);

+		Tcl_DictObjDone(&search);

+		break;

+	    } else {

+		Tcl_DictObjDone(&search);

+		break;

+	    }

+	}

+

+	Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);

+    }

+

+    /*

+     * Stop holding a reference to these objects.

+     */

+    Tcl_DecrRefCount(keyVarObj);

+    Tcl_DecrRefCount(valueVarObj);

+    Tcl_DecrRefCount(dictObj);

+    Tcl_DecrRefCount(scriptObj);

+

+    if (result == TCL_OK) {

+	Tcl_ResetResult(interp);

+    }

+    return result;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictSetCmd --

+ *

+ *	This function implements the "dict set" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictSetCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictPtr, *resultPtr;

+    int result, allocatedDict = 0;

+

+    if (objc < 5) {

+	Tcl_WrongNumArgs(interp, 2, objv, "varName key ?key ...? value");

+	return TCL_ERROR;

+    }

+

+    dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);

+    if (dictPtr == NULL) {

+	allocatedDict = 1;

+	dictPtr = Tcl_NewDictObj();

+    } else if (Tcl_IsShared(dictPtr)) {

+	allocatedDict = 1;

+	dictPtr = Tcl_DuplicateObj(dictPtr);

+    }

+

+    result = Tcl_DictObjPutKeyList(interp, dictPtr, objc-4, objv+3,

+	    objv[objc-1]);

+    if (result != TCL_OK) {

+	if (allocatedDict) {

+	    Tcl_DecrRefCount(dictPtr);

+	}

+	return TCL_ERROR;

+    }

+

+    resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,

+	    TCL_LEAVE_ERR_MSG);

+    if (resultPtr == NULL) {

+	if (allocatedDict) {

+	    Tcl_DecrRefCount(dictPtr);

+	}

+	return TCL_ERROR;

+    }

+    Tcl_SetObjResult(interp, resultPtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictUnsetCmd --

+ *

+ *	This function implements the "dict unset" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictUnsetCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    Tcl_Obj *dictPtr, *resultPtr;

+    int result, allocatedDict = 0;

+

+    if (objc < 4) {

+	Tcl_WrongNumArgs(interp, 2, objv, "varName key ?key ...?");

+	return TCL_ERROR;

+    }

+

+    dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0);

+    if (dictPtr == NULL) {

+	allocatedDict = 1;

+	dictPtr = Tcl_NewDictObj();

+    } else if (Tcl_IsShared(dictPtr)) {

+	allocatedDict = 1;

+	dictPtr = Tcl_DuplicateObj(dictPtr);

+    }

+

+    result = Tcl_DictObjRemoveKeyList(interp, dictPtr, objc-3, objv+3);

+    if (result != TCL_OK) {

+	if (allocatedDict) {

+	    Tcl_DecrRefCount(dictPtr);

+	}

+	return TCL_ERROR;

+    }

+

+    resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr,

+	    TCL_LEAVE_ERR_MSG);

+    if (resultPtr == NULL) {

+	if (allocatedDict) {

+	    Tcl_DecrRefCount(dictPtr);

+	}

+	return TCL_ERROR;

+    }

+    Tcl_SetObjResult(interp, resultPtr);

+    return TCL_OK;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * DictFilterCmd --

+ *

+ *	This function implements the "dict filter" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+static int

+DictFilterCmd(interp, objc, objv)

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    static CONST char *filters[] = {

+	"key", "script", "value", NULL

+    };

+    enum FilterTypes {

+	FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES

+    };

+    Tcl_Obj *dictObj, *scriptObj, *keyVarObj, *valueVarObj;

+    Tcl_Obj **varv, *keyObj, *valueObj, *resultObj, *boolObj;

+    Tcl_DictSearch search;

+    int index, varc, done, result, satisfied;

+    char *pattern;

+    char msg[32 + TCL_INTEGER_SPACE];

+

+    if (objc < 4) {

+	Tcl_WrongNumArgs(interp, 2, objv, "dictionary filterType ...");

+	return TCL_ERROR;

+    }

+    if (Tcl_GetIndexFromObj(interp, objv[3], filters, "filterType",

+	     0, &index) != TCL_OK) {

+	return TCL_ERROR;

+    }

+

+    switch ((enum FilterTypes) index) {

+    case FILTER_KEYS:

+	if (objc != 5) {

+	    Tcl_WrongNumArgs(interp, 2, objv, "dictionary key globPattern");

+	    return TCL_ERROR;

+	}

+

+	/*

+	 * Create a dictionary whose keys all match a certain pattern.

+	 */

+	if (Tcl_DictObjFirst(interp, objv[2], &search,

+		&keyObj, &valueObj, &done) != TCL_OK) {

+	    return TCL_ERROR;

+	}

+	pattern = TclGetString(objv[4]);

+	resultObj = Tcl_NewDictObj();

+	while (!done) {

+	    if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {

+		Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);

+	    }

+	    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);

+	}

+	Tcl_SetObjResult(interp, resultObj);

+	return TCL_OK;

+

+    case FILTER_VALUES:

+	if (objc != 5) {

+	    Tcl_WrongNumArgs(interp, 2, objv, "dictionary value globPattern");

+	    return TCL_ERROR;

+	}

+

+	/*

+	 * Create a dictionary whose values all match a certain pattern.

+	 */

+	if (Tcl_DictObjFirst(interp, objv[2], &search,

+		&keyObj, &valueObj, &done) != TCL_OK) {

+	    return TCL_ERROR;

+	}

+	pattern = TclGetString(objv[4]);

+	resultObj = Tcl_NewDictObj();

+	while (!done) {

+	    if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {

+		Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);

+	    }

+	    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);

+	}

+	Tcl_SetObjResult(interp, resultObj);

+	return TCL_OK;

+

+    case FILTER_SCRIPT:

+	if (objc != 6) {

+	    Tcl_WrongNumArgs(interp, 2, objv,

+		    "dictionary script {keyVar valueVar} filterScript");

+	    return TCL_ERROR;

+	}

+

+	/*

+	 * Create a dictionary whose key,value pairs all satisfy a

+	 * script (i.e. get a true boolean result from its

+	 * evaluation.)  Massive copying from the "dict for"

+	 * implementation has occurred!

+	 */

+

+	if (Tcl_ListObjGetElements(interp, objv[4], &varc, &varv) != TCL_OK) {

+	    return TCL_ERROR;

+	}

+	if (varc != 2) {

+	    Tcl_ResetResult(interp);

+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

+		    "must have exactly two variable names", NULL);

+	    return TCL_ERROR;

+	}

+	keyVarObj = varv[0];

+	valueVarObj = varv[1];

+	dictObj = objv[2];

+	scriptObj = objv[5];

+	/*

+	 * Make sure that these objects (which we need throughout the

+	 * body of the loop) don't vanish.  Note that we also care

+	 * that the dictObj remains a dictionary, which requires

+	 * slightly more elaborate precautions.  That we achieve by

+	 * making sure that the type is static throughout and that the

+	 * hash is the same hash throughout; taking a copy of the

+	 * whole thing would be easier, but much less efficient.

+	 */

+	Tcl_IncrRefCount(keyVarObj);

+	Tcl_IncrRefCount(valueVarObj);

+	Tcl_IncrRefCount(dictObj);

+	Tcl_IncrRefCount(scriptObj);

+

+	result = Tcl_DictObjFirst(interp, dictObj,

+		&search, &keyObj, &valueObj, &done);

+	if (result != TCL_OK) {

+	    Tcl_DecrRefCount(keyVarObj);

+	    Tcl_DecrRefCount(valueVarObj);

+	    Tcl_DecrRefCount(dictObj);

+	    Tcl_DecrRefCount(scriptObj);

+	    return TCL_ERROR;

+	}

+

+	resultObj = Tcl_NewDictObj();

+

+	while (!done) {

+	    /*

+	     * Stop the value from getting hit in any way by any

+	     * traces on the key variable.

+	     */

+	    Tcl_IncrRefCount(keyObj);

+	    Tcl_IncrRefCount(valueObj);

+	    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,

+		    TCL_LEAVE_ERR_MSG) == NULL) {

+		Tcl_ResetResult(interp);

+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

+			"couldn't set key variable: \"",

+			Tcl_GetString(keyVarObj), "\"", (char *) NULL);

+		result = TCL_ERROR;

+		goto abnormalResult;

+	    }

+	    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,

+		    TCL_LEAVE_ERR_MSG) == NULL) {

+		Tcl_ResetResult(interp);

+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

+			"couldn't set value variable: \"",

+			Tcl_GetString(keyVarObj), "\"", (char *) NULL);

+		goto abnormalResult;

+	    }

+

+	    result = Tcl_EvalObjEx(interp, scriptObj, 0);

+	    switch (result) {

+	    case TCL_OK:

+		boolObj = Tcl_GetObjResult(interp);

+		Tcl_IncrRefCount(boolObj);

+		Tcl_ResetResult(interp);

+		if (Tcl_GetBooleanFromObj(interp, boolObj,

+			&satisfied) != TCL_OK) {

+		    Tcl_DecrRefCount(boolObj);

+		    result = TCL_ERROR;

+		    goto abnormalResult;

+		}

+		Tcl_DecrRefCount(boolObj);

+		if (satisfied) {

+		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);

+		}

+	    case TCL_CONTINUE:

+		result = TCL_OK;

+		break;

+	    case TCL_BREAK:

+		/*

+		 * Force loop termination.  Has to be done with a jump

+		 * so we remove references to the dictionary correctly.

+		 */

+		Tcl_ResetResult(interp);

+		Tcl_DictObjDone(&search);

+		result = TCL_OK;

+		goto normalResult;

+	    case TCL_ERROR:

+		sprintf(msg, "\n    (\"dict filter\" script line %d)",

+			interp->errorLine);

+		Tcl_AddObjErrorInfo(interp, msg, -1);

+	    default:

+		goto abnormalResult;

+	    }

+

+	    Tcl_DecrRefCount(keyObj);

+	    Tcl_DecrRefCount(valueObj);

+

+	    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);

+	}

+

+    normalResult:

+	/*

+	 * Stop holding a reference to these objects.

+	 */

+	Tcl_DecrRefCount(keyVarObj);

+	Tcl_DecrRefCount(valueVarObj);

+	Tcl_DecrRefCount(dictObj);

+	Tcl_DecrRefCount(scriptObj);

+

+	if (result == TCL_OK) {

+	    Tcl_SetObjResult(interp, resultObj);

+	} else {

+	    Tcl_DecrRefCount(resultObj);

+	}

+	return result;

+    }

+    panic("unexpected fallthrough");

+    /* Control never reaches this point. */

+

+  abnormalResult:

+    Tcl_DictObjDone(&search);

+    Tcl_DecrRefCount(keyObj);

+    Tcl_DecrRefCount(valueObj);

+    Tcl_DecrRefCount(keyVarObj);

+    Tcl_DecrRefCount(valueVarObj);

+    Tcl_DecrRefCount(dictObj);

+    Tcl_DecrRefCount(scriptObj);

+    Tcl_DecrRefCount(resultObj);

+    return result;

+}

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * Tcl_DictObjCmd --

+ *

+ *	This function is invoked to process the "dict" Tcl command.

+ *	See the user documentation for details on what it does, and

+ *	TIP#??? for the formal specification.

+ *

+ * Results:

+ *	A standard Tcl result.

+ *

+ * Side effects:

+ *	See the user documentation.

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+Tcl_DictObjCmd(/*ignored*/ clientData, interp, objc, objv)

+    ClientData clientData;

+    Tcl_Interp *interp;

+    int objc;

+    Tcl_Obj *CONST *objv;

+{

+    static CONST char *subcommands[] = {

+	"append", "create", "exists", "filter", "for",

+	"get", "incr", "info", "keys", "lappend", "remove",

+	"replace", "set", "size", "unset", "values", NULL

+    };

+    enum DictSubcommands {

+	DICT_APPEND, DICT_CREATE, DICT_EXISTS, DICT_FILTER, DICT_FOR,

+	DICT_GET, DICT_INCR, DICT_INFO, DICT_KEYS, DICT_LAPPEND, DICT_REMOVE,

+	DICT_REPLACE, DICT_SET, DICT_SIZE, DICT_UNSET, DICT_VALUES

+    };

+    int index;

+

+    if (objc < 2) {

+	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");

+	return TCL_ERROR;

+    }

+    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand",

+	    0, &index) != TCL_OK) {

+	return TCL_ERROR;

+    }

+    switch ((enum DictSubcommands) index) {

+    case DICT_APPEND:	return DictAppendCmd(interp, objc, objv);

+    case DICT_CREATE:	return DictCreateCmd(interp, objc, objv);

+    case DICT_EXISTS:	return DictExistsCmd(interp, objc, objv);

+    case DICT_FILTER:	return DictFilterCmd(interp, objc, objv);

+    case DICT_FOR:	return DictForCmd(interp, objc, objv);

+    case DICT_GET:	return DictGetCmd(interp, objc, objv);

+    case DICT_INCR:	return DictIncrCmd(interp, objc, objv);

+    case DICT_INFO:	return DictInfoCmd(interp, objc, objv);

+    case DICT_KEYS:	return DictKeysCmd(interp, objc, objv);

+    case DICT_LAPPEND:	return DictLappendCmd(interp, objc, objv);

+    case DICT_REMOVE:	return DictRemoveCmd(interp, objc, objv);

+    case DICT_REPLACE:	return DictReplaceCmd(interp, objc, objv);

+    case DICT_SET:	return DictSetCmd(interp, objc, objv);

+    case DICT_SIZE:	return DictSizeCmd(interp, objc, objv);

+    case DICT_UNSET:	return DictUnsetCmd(interp, objc, objv);

+    case DICT_VALUES:	return DictValuesCmd(interp, objc, objv);

+    }

+    panic("unexpected fallthrough!");

+}

diff --git a/tests/dict.test b/tests/dict.test
new file mode 100644
index 0000000..6d27533
--- /dev/null
+++ b/tests/dict.test
@@ -0,0 +1,706 @@
+# This test file covers the dictionary object type and the dict
+# command used to work with values of that type.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 2003 Donal K. Fellows
+# 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 $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+# Procedure to help check the contents of a dictionary.  Note that we
+# can't just compare the string version because the order of the
+# elements is (deliberately) not defined.  This is because it is
+# dependent on the underlying hash table implementation and also
+# potentially on the history of the value itself.  Net result: you
+# cannot safely assume anything about the ordering of values.
+proc getOrder {dictVal args} {
+    foreach key $args {
+	lappend result $key [dict get $dictVal $key]
+    }
+    lappend result [dict size $dictVal]
+    return $result
+}
+
+test dict-1.1 {dict command basic syntax} {
+    list [catch {dict} msg] $msg
+} {1 {wrong # args: should be "dict subcommand ?arg ...?"}}
+test dict-1.2 {dict command basic syntax} {
+    list [catch {dict ?} msg] $msg
+} {1 {bad subcommand "?": must be append, create, exists, filter, for, get, incr, info, keys, lappend, remove, replace, set, size, unset, or values}}
+
+test dict-2.1 {dict create command} {
+    dict create
+} {}
+test dict-2.2 {dict create command} {
+    dict create a b
+} {a b}
+test dict-2.3 {dict create command} {
+    set result {}
+    set dict [dict create a b c d]
+    # Can't compare directly as ordering of values is undefined
+    foreach key {a c} {
+	set idx [lsearch -exact $dict $key]
+	if {$idx & 1} {
+	    error "found $key at odd index $idx in $dict"
+	}
+	lappend result [lindex $dict [expr {$idx+1}]]
+    }
+    set result
+} {b d}
+test dict-2.4 {dict create command} {
+    list [catch {dict create a} msg] $msg
+} {1 {wrong # args: should be "dict create ?key value ...?"}}
+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-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
+test dict-3.3 {dict get command} {dict get {a b c d} c} d
+test dict-3.4 {dict get command} {
+    list [catch {dict get {a b c d} b} msg] $msg
+} {1 {key "b" not known in dictionary}}
+test dict-3.5 {dict get command} {dict get {a {p q r s} b {u v x y}} a p} q
+test dict-3.6 {dict get command} {dict get {a {p q r s} b {u v x y}} a r} s
+test dict-3.7 {dict get command} {dict get {a {p q r s} b {u v x y}} b u} v
+test dict-3.8 {dict get command} {dict get {a {p q r s} b {u v x y}} b x} y
+test dict-3.9 {dict get command} {
+    list [catch {dict get {a {p q r s} b {u v x y}} a z} msg] $msg
+} {1 {key "z" not known in dictionary}}
+test dict-3.10 {dict get command} {
+    list [catch {dict get {a {p q r s} b {u v x y}} c z} msg] $msg
+} {1 {key "c" not known in dictionary}}
+test dict-3.11 {dict get command} {dict get [dict create a b c d] a} b
+test dict-3.12 {dict get command} {
+    list [catch {dict get} msg] $msg
+} {1 {wrong # args: should be "dict get dictionary ?key key ...?"}}
+test dict-3.13 {dict get command} {
+    set dict [dict get {a b c d}]
+    if {$dict eq "a b c d"} {
+	subst OK
+    } elseif {$dict eq "c d a b"} {
+	subst OK
+    } else {
+	set dict
+    }
+} OK
+test dict-3.14 {dict get command} {
+    list [catch {dict get {a b c d} a c} msg] $msg
+} {1 {missing value to go with key}}
+
+test dict-4.1 {dict replace command} {
+    getOrder [dict replace {a b c d}] a c
+} {a b c d 2}
+test dict-4.2 {dict replace command} {
+    getOrder [dict replace {a b c d} e f] a c e
+} {a b c d e f 3}
+test dict-4.3 {dict replace command} {
+    getOrder [dict replace {a b c d} c f] a c
+} {a b c f 2}
+test dict-4.4 {dict replace command} {
+    getOrder [dict replace {a b c d} c x a y] a c
+} {a y c x 2}
+test dict-4.5 {dict replace command} {
+    list [catch {dict replace} msg] $msg
+} {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}}
+test dict-4.6 {dict replace command} {
+    list [catch {dict replace {a a} a} msg] $msg
+} {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}}
+test dict-4.7 {dict replace command} {
+    list [catch {dict replace {a a a} a b} msg] $msg
+} {1 {missing value to go with key}}
+test dict-4.8 {dict replace command} {
+    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-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}
+test dict-5.3 {dict remove command} {dict remove {a b c d} a c} {}
+test dict-5.4 {dict remove command} {dict remove {a b c d} c a} {}
+test dict-5.5 {dict remove command} {
+    getOrder [dict remove {a b c d}] a c
+} {a b c d 2}
+test dict-5.6 {dict remove command} {dict remove {a b} c} {a b}
+test dict-5.7 {dict remove command} {
+    list [catch {dict remove} msg] $msg
+} {1 {wrong # args: should be "dict remove dictionary ?key ...?"}}
+
+test dict-6.1 {dict keys command} {dict keys {a b}} a
+test dict-6.2 {dict keys command} {dict keys {c d}} c
+test dict-6.3 {dict keys command} {lsort [dict keys {a b c d}]} {a c}
+test dict-6.4 {dict keys command} {dict keys {a b c d} a} a
+test dict-6.5 {dict keys command} {dict keys {a b c d} c} c
+test dict-6.6 {dict keys command} {dict keys {a b c d} e} {}
+test dict-6.7 {dict keys command} {lsort [dict keys {a b c d ca da} c*]} {c ca}
+test dict-6.8 {dict keys command} {
+    list [catch {dict keys} msg] $msg
+} {1 {wrong # args: should be "dict keys dictionary ?pattern?"}}
+test dict-6.9 {dict keys command} {
+    list [catch {dict keys {} a b} msg] $msg
+} {1 {wrong # args: should be "dict keys dictionary ?pattern?"}}
+test dict-6.10 {dict keys command} {
+    list [catch {dict keys a} msg] $msg
+} {1 {missing value to go with key}}
+
+test dict-7.1 {dict values command} {dict values {a b}} b
+test dict-7.2 {dict values command} {dict values {c d}} d
+test dict-7.3 {dict values command} {lsort [dict values {a b c d}]} {b d}
+test dict-7.4 {dict values command} {dict values {a b c d} b} b
+test dict-7.5 {dict values command} {dict values {a b c d} d} d
+test dict-7.6 {dict values command} {dict values {a b c d} e} {}
+test dict-7.7 {dict values command} {lsort [dict values {a b c d ca da} d*]} {d da}
+test dict-7.8 {dict values command} {
+    list [catch {dict values} msg] $msg
+} {1 {wrong # args: should be "dict values dictionary ?pattern?"}}
+test dict-7.9 {dict values command} {
+    list [catch {dict values {} a b} msg] $msg
+} {1 {wrong # args: should be "dict values dictionary ?pattern?"}}
+test dict-7.10 {dict values command} {
+    list [catch {dict values a} msg] $msg
+} {1 {missing value to go with key}}
+
+test dict-8.1 {dict size command} {dict size {}} 0
+test dict-8.2 {dict size command} {dict size {a b}} 1
+test dict-8.3 {dict size command} {dict size {a b c d}} 2
+test dict-8.4 {dict size command} {
+    list [catch {dict size} msg] $msg
+} {1 {wrong # args: should be "dict size dictionary"}}
+test dict-8.5 {dict size command} {
+    list [catch {dict size a b} msg] $msg
+} {1 {wrong # args: should be "dict size dictionary"}}
+test dict-8.6 {dict size command} {
+    list [catch {dict size a} msg] $msg
+} {1 {missing value to go with key}}
+
+test dict-9.1 {dict exists command} {dict exists {a b} a} 1
+test dict-9.2 {dict exists command} {dict exists {a b} b} 0
+test dict-9.3 {dict exists command} {dict exists {a {b c}} a b} 1
+test dict-9.4 {dict exists command} {dict exists {a {b c}} a c} 0
+test dict-9.5 {dict exists command} {
+    list [catch {dict exists {a {b c}} b c} msg] $msg
+} {1 {key "b" not known in dictionary}}
+test dict-9.6 {dict exists command} {
+    list [catch {dict exists {a {b c d}} a c} msg] $msg
+} {1 {missing value to go with key}}
+test dict-9.7 {dict exists command} {
+    list [catch {dict exists} msg] $msg
+} {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}}
+test dict-9.8 {dict exists command} {
+    list [catch {dict exists {}} msg] $msg
+} {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}}
+
+test dict-10.1 {dict info command} {
+    # Actual string returned by this command is undefined; it is
+    # intended for human consumption and not for use by scripts.
+    dict info {}
+    subst {}
+} {}
+test dict-10.2 {dict info command} {
+    list [catch {dict info} msg] $msg
+} {1 {wrong # args: should be "dict info dictionary"}}
+test dict-10.3 {dict info command} {
+    list [catch {dict info {} x} msg] $msg
+} {1 {wrong # args: should be "dict info dictionary"}}
+test dict-10.4 {dict info command} {
+    list [catch {dict info x} msg] $msg
+} {1 {missing value to go with key}}
+
+test dict-11.1 {dict incr command: unshared value} {
+    set dictv [dict create \
+	    a [string index "=0=" 1] \
+	    b [expr {1+2}] \
+	    c [expr {wide(0x80000000)+1}]]
+    getOrder [dict incr dictv a] a b c
+} {a 1 b 3 c 2147483649 3}
+test dict-11.2 {dict incr command: unshared value} {
+    set dictv [dict create \
+	    a [string index "=0=" 1] \
+	    b [expr {1+2}] \
+	    c [expr {wide(0x80000000)+1}]]
+    getOrder [dict incr dictv b] a b c
+} {a 0 b 4 c 2147483649 3}
+test dict-11.3 {dict incr command: unshared value} {
+    set dictv [dict create \
+	    a [string index "=0=" 1] \
+	    b [expr {1+2}] \
+	    c [expr {wide(0x80000000)+1}]]
+    getOrder [dict incr dictv c] a b c
+} {a 0 b 3 c 2147483650 3}
+test dict-11.4 {dict incr command: shared value} {
+    set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
+    set sharing [dict values $dictv]
+    getOrder [dict incr dictv a] a b c
+} {a 1 b 3 c 2147483649 3}
+test dict-11.5 {dict incr command: shared value} {
+    set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
+    set sharing [dict values $dictv]
+    getOrder [dict incr dictv b] a b c
+} {a 0 b 4 c 2147483649 3}
+test dict-11.6 {dict incr command: shared value} {
+    set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
+    set sharing [dict values $dictv]
+    getOrder [dict incr dictv c] a b c
+} {a 0 b 3 c 2147483650 3}
+test dict-11.7 {dict incr command: unknown values} {
+    set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
+    getOrder [dict incr dictv d] a b c d
+} {a 0 b 3 c 2147483649 d 1 4}
+test dict-11.8 {dict incr command} {
+    set dictv {a 1}
+    dict incr dictv a 2
+} {a 3}
+test dict-11.9 {dict incr command} {
+    set dictv {a dummy}
+    list [catch {dict incr dictv a} msg] $msg
+} {1 {expected integer but got "dummy"}}
+test dict-11.10 {dict incr command} {
+    set dictv {a 1}
+    list [catch {dict incr dictv a dummy} msg] $msg
+} {1 {expected integer but got "dummy"}}
+test dict-11.11 {dict incr command} {
+    catch {unset dictv}
+    dict incr dictv a
+} {a 1}
+test dict-11.12 {dict incr command} {
+    set dictv a
+    list [catch {dict incr dictv a} msg] $msg
+} {1 {missing value to go with key}}
+test dict-11.13 {dict incr command} {
+    set dictv a
+    list [catch {dict incr dictv a a a} msg] $msg
+} {1 {wrong # args: should be "dict incr varName key ?increment?"}}
+test dict-11.14 {dict incr command} {
+    set dictv a
+    list [catch {dict incr dictv} msg] $msg
+} {1 {wrong # args: should be "dict incr varName key ?increment?"}}
+test dict-11.15 {dict incr command: write failure} {
+    catch {unset dictVar}
+    set dictVar(block) {}
+    set result [list [catch {dict incr dictVar a} msg] $msg]
+    catch {unset dictVar}
+    set result
+} {1 {can't set "dictVar": variable is array}}
+
+test dict-12.1 {dict lappend command} {
+    set dictv {a a}
+    dict lappend dictv a
+} {a a}
+test dict-12.2 {dict lappend command} {
+    set dictv {a a}
+    set sharing [dict values $dictv]
+    dict lappend dictv a b
+} {a {a b}}
+test dict-12.3 {dict lappend command} {
+    set dictv {a a}
+    dict lappend dictv a b c
+} {a {a b c}}
+test dict-12.2 {dict lappend command} {
+    set dictv [dict create a [string index =a= 1]]
+    dict lappend dictv a b
+} {a {a b}}
+test dict-12.4 {dict lappend command} {
+    set dictv {}
+    dict lappend dictv a x y z
+} {a {x y z}}
+test dict-12.5 {dict lappend command} {
+    catch {unset dictv}
+    dict lappend dictv a b
+} {a b}
+test dict-12.6 {dict lappend command} {
+    set dictv a
+    list [catch {dict lappend dictv a a} msg] $msg
+} {1 {missing value to go with key}}
+test dict-12.7 {dict lappend command} {
+    list [catch {dict lappend} msg] $msg
+} {1 {wrong # args: should be "dict lappend varName key ?value ...?"}}
+test dict-12.8 {dict lappend command} {
+    list [catch {dict lappend dictv} msg] $msg
+} {1 {wrong # args: should be "dict lappend varName key ?value ...?"}}
+test dict-12.9 {dict lappend command} {
+    set dictv [dict create a "\{"]
+    list [catch {dict lappend dictv a a} msg] $msg
+} {1 {unmatched open brace in list}}
+test dict-12.10 {dict lappend command: write failure} {
+    catch {unset dictVar}
+    set dictVar(block) {}
+    set result [list [catch {dict lappend dictVar a x} msg] $msg]
+    catch {unset dictVar}
+    set result
+} {1 {can't set "dictVar": variable is array}}
+
+test dict-13.1 {dict append command} {
+    set dictv {a a}
+    dict append dictv a
+} {a a}
+test dict-13.2 {dict append command} {
+    set dictv {a a}
+    set sharing [dict values $dictv]
+    dict append dictv a b
+} {a ab}
+test dict-13.3 {dict append command} {
+    set dictv {a a}
+    dict append dictv a b c
+} {a abc}
+test dict-13.2 {dict append command} {
+    set dictv [dict create a [string index =a= 1]]
+    dict append dictv a b
+} {a ab}
+test dict-13.4 {dict append command} {
+    set dictv {}
+    dict append dictv a x y z
+} {a xyz}
+test dict-13.5 {dict append command} {
+    catch {unset dictv}
+    dict append dictv a b
+} {a b}
+test dict-13.6 {dict append command} {
+    set dictv a
+    list [catch {dict append dictv a a} msg] $msg
+} {1 {missing value to go with key}}
+test dict-13.7 {dict append command} {
+    list [catch {dict append} msg] $msg
+} {1 {wrong # args: should be "dict append varName key ?value ...?"}}
+test dict-13.8 {dict append command} {
+    list [catch {dict append dictv} msg] $msg
+} {1 {wrong # args: should be "dict append varName key ?value ...?"}}
+test dict-13.9 {dict append command: write failure} {
+    catch {unset dictVar}
+    set dictVar(block) {}
+    set result [list [catch {dict append dictVar a x} msg] $msg]
+    catch {unset dictVar}
+    set result
+} {1 {can't set "dictVar": variable is array}}
+
+test dict-14.1 {dict for command: syntax} {
+    list [catch {dict for} msg] $msg
+} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
+test dict-14.2 {dict for command: syntax} {
+    list [catch {dict for x} msg] $msg
+} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
+test dict-14.3 {dict for command: syntax} {
+    list [catch {dict for x x} msg] $msg
+} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
+test dict-14.4 {dict for command: syntax} {
+    list [catch {dict for x x x x} msg] $msg
+} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
+test dict-14.5 {dict for command: syntax} {
+    list [catch {dict for x x x} msg] $msg
+} {1 {must have exactly two variable names}}
+test dict-14.6 {dict for command: syntax} {
+    list [catch {dict for {x x x} x x} msg] $msg
+} {1 {must have exactly two variable names}}
+test dict-14.7 {dict for command: syntax} {
+    list [catch {dict for "\{x" x x} msg] $msg
+} {1 {unmatched open brace in list}}
+test dict-14.8 {dict for command} {
+    # This test confirms that [dict keys], [dict values] and [dict for]
+    # all traverse a dictionary in the same order.
+    set dictv {a A b B c C}
+    set keys {}
+    set values {}
+    dict for {k v} $dictv {
+	lappend keys $k
+	lappend values $v
+    }
+    set result [expr {
+	$keys eq [dict keys $dictv] && $values eq [dict values $dictv]
+    }]
+    expr {$result ? "YES" : [list "NO" $dictv $keys $values]}
+} YES
+test dict-14.9 {dict for command} {
+    dict for {k v} {} {
+	error "unexpected execution of 'dict for' body"
+    }
+} {}
+test dict-14.10 {dict for command: script results} {
+    set times 0
+    dict for {k v} {a a b b} {
+	incr times
+	continue
+	error "shouldn't get here"
+    }
+    set times
+} 2
+test dict-14.11 {dict for command: script results} {
+    set times 0
+    dict for {k v} {a a b b} {
+	incr times
+	break
+	error "shouldn't get here"
+    }
+    set times
+} 1
+test dict-14.12 {dict for command: script results} {
+    set times 0
+    list [catch {
+	dict for {k v} {a a b b} {
+	    incr times
+	    error test
+	}
+    } msg] $msg $times $::errorInfo
+} {1 test 1 {test
+    while executing
+"error test"
+    ("dict for" body line 3)
+    invoked from within
+"dict for {k v} {a a b b} {
+	    incr times
+	    error test
+	}"}}
+test dict-14.13 {dict for command: script results} {
+    proc dicttest {} {
+	rename dicttest {}
+	dict for {k v} {a b} {
+	    return ok,$k,$v
+	    error "skipped return completely"
+	}
+	error "return didn't go far enough"
+    }
+    dicttest
+} ok,a,b
+test dict-14.14 {dict for command: handle representation loss} {
+    set dictVar {a b c d e f g h}
+    set keys {}
+    set values {}
+    dict for {k v} $dictVar {
+	if {[llength $dictVar]} {
+	    lappend keys $k
+	    lappend values $v
+	}
+    }
+    list [lsort $keys] [lsort $values]
+} {{a c e g} {b d f h}}
+test dict-14.15 {dict for command: keys are unique and iterated over once only} {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+    catch {unset accum}
+    array set accum {}
+    dict for {k v} $dictVar {
+	append accum($k) $v,
+    }
+    set result [lsort [array names accum]]
+    lappend result :
+    foreach k $result {
+	catch {lappend result $accum($k)}
+    }
+    catch {unset accum}
+    set result
+} {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
+# There's probably a lot more tests to add here.  Really ought to use
+# a coverage tool for this job...
+
+test dict-15.1 {dict set command} {
+    set dictVar {}
+    dict set dictVar a x
+} {a x}
+test dict-15.2 {dict set command} {
+    set dictvar {a {}}
+    dict set dictvar a b x
+} {a {b x}}
+test dict-15.3 {dict set command} {
+    set dictvar {a {b {}}}
+    dict set dictvar a b c x
+} {a {b {c x}}}
+test dict-15.4 {dict set command} {
+    set dictVar {a y}
+    dict set dictVar a x
+} {a x}
+test dict-15.5 {dict set command} {
+    set dictVar {a {b y}}
+    dict set dictVar a b x
+} {a {b x}}
+test dict-15.6 {dict set command} {
+    set dictVar {a {b {c y}}}
+    dict set dictVar a b c x
+} {a {b {c x}}}
+test dict-15.7 {dict set command: no path creation} {
+    set dictVar {}
+    list [catch {dict set dictVar a b x} msg] $msg
+} {1 {key "a" not known in dictionary}}
+test dict-15.8 {dict set command: creates variables} {
+    catch {unset dictVar}
+    dict set dictVar a x
+    set dictVar
+} {a x}
+test dict-15.9 {dict set command: write failure} {
+    catch {unset dictVar}
+    set dictVar(block) {}
+    set result [list [catch {dict set dictVar a x} msg] $msg]
+    catch {unset dictVar}
+    set result
+} {1 {can't set "dictVar": variable is array}}
+test dict-15.10 {dict set command: syntax} {
+    list [catch {dict set} msg] $msg
+} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
+test dict-15.11 {dict set command: syntax} {
+    list [catch {dict set a} msg] $msg
+} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
+test dict-15.12 {dict set command: syntax} {
+    list [catch {dict set a a} msg] $msg
+} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
+test dict-15.13 {dict set command} {
+    set dictVar a
+    list [catch {dict set dictVar b c} msg] $msg
+} {1 {missing value to go with key}}
+
+test dict-16.1 {dict unset command} {
+    set dictVar {a b c d}
+    dict unset dictVar a
+} {c d}
+test dict-16.2 {dict unset command} {
+    set dictVar {a b c d}
+    dict unset dictVar c
+} {a b}
+test dict-16.3 {dict unset command} {
+    set dictVar {a b}
+    dict unset dictVar c
+} {a b}
+test dict-16.4 {dict unset command} {
+    set dictVar {a {b c d e}}
+    dict unset dictVar a b
+} {a {d e}}
+test dict-16.5 {dict unset command} {
+    set dictVar a
+    list [catch {dict unset dictVar a} msg] $msg
+} {1 {missing value to go with key}}
+test dict-16.6 {dict unset command} {
+    set dictVar {a b}
+    list [catch {dict unset dictVar c d} msg] $msg
+} {1 {key "c" not known in dictionary}}
+test dict-16.7 {dict unset command} {
+    catch {unset dictVar}
+    list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]
+} {0 {} 1}
+test dict-16.8 {dict unset command} {
+    list [catch {dict unset dictVar} msg] $msg
+} {1 {wrong # args: should be "dict unset varName key ?key ...?"}}
+test dict-16.9 {dict unset command: write failure} {
+    catch {unset dictVar}
+    set dictVar(block) {}
+    set result [list [catch {dict unset dictVar a} msg] $msg]
+    catch {unset dictVar}
+    set result
+} {1 {can't set "dictVar": variable is array}}
+
+test dict-17.1 {dict filter command: key} {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+    dict filter $dictVar key a2
+} {a2 b}
+test dict-17.2 {dict filter command: key} {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+    dict size [dict filter $dictVar key *]
+} 6
+test dict-17.3 {dict filter command: key} {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+    getOrder [dict filter $dictVar key ???] bar foo
+} {bar foo foo bar 2}
+test dict-17.4 {dict filter command: key} {
+    list [catch {dict filter {} key} msg] $msg
+} {1 {wrong # args: should be "dict filter dictionary key globPattern"}}
+test dict-17.5 {dict filter command: key} {
+    list [catch {dict filter {} key a a} msg] $msg
+} {1 {wrong # args: should be "dict filter dictionary key globPattern"}}
+test dict-17.6 {dict filter command: value} {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+    dict filter $dictVar value c
+} {b1 c}
+test dict-17.7 {dict filter command: value} {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+    dict size [dict filter $dictVar value *]
+} 6
+test dict-17.8 {dict filter command: value} {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+    getOrder [dict filter $dictVar value ???] bar foo
+} {bar foo foo bar 2}
+test dict-17.9 {dict filter command: value} {
+    list [catch {dict filter {} value} msg] $msg
+} {1 {wrong # args: should be "dict filter dictionary value globPattern"}}
+test dict-17.10 {dict filter command: value} {
+    list [catch {dict filter {} value a a} msg] $msg
+} {1 {wrong # args: should be "dict filter dictionary value globPattern"}}
+test dict-17.11 {dict filter command: script} {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+    set n 0
+    list [getOrder [dict filter $dictVar script {k v} {
+	incr n
+	expr {[string length $k] == [string length $v]}
+    }] bar foo] $n
+} {{bar foo foo bar 2} 6}
+test dict-17.12 {dict filter command: script} {
+    list [catch {dict filter {a b} script {k v} {concat $k $v}} msg] $msg
+} {1 {expected boolean value but got "a b"}}
+test dict-17.13 {dict filter command: script} {
+    list [catch {dict filter {a b} script {k v} {error x}} msg] $msg \
+	    $::errorInfo
+} {1 x {x
+    while executing
+"error x"
+    ("dict filter" script line 1)
+    invoked from within
+"dict filter {a b} script {k v} {error x}"}}
+test dict-17.14 {dict filter command: script} {
+    set n 0
+    list [dict filter {a b c d} script {k v} {
+	incr n
+	break
+	error boom!
+    }] $n
+} {{} 1}
+test dict-17.15 {dict filter command: script} {
+    set n 0
+    list [dict filter {a b c d} script {k v} {
+	incr n
+	continue
+	error boom!
+    }] $n
+} {{} 2}
+test dict-17.16 {dict filter command: script} {
+    proc dicttest {} {
+	rename dicttest {}
+	dict filter {a b} script {k v} {
+	    return ok,$k,$v
+	    error "skipped return completely"
+	}
+	error "return didn't go far enough"
+    }
+    dicttest
+} ok,a,b
+test dict-17.17 {dict filter command: script} {
+    dict filter {a b} script {k k} {continue}
+    set k
+} b
+test dict-17.18 {dict filter command: script} {
+    list [catch {dict filter {a b} script {k k}} msg] $msg
+} {1 {wrong # args: should be "dict filter dictionary script {keyVar valueVar} filterScript"}}
+test dict-17.19 {dict filter command: script} {
+    list [catch {dict filter {a b} script k {continue}} msg] $msg
+} {1 {must have exactly two variable names}}
+test dict-17.20 {dict filter command: script} {
+    list [catch {dict filter {a b} script "\{k v" {continue}} msg] $msg
+} {1 {unmatched open brace in list}}
+test dict-17.21 {dict filter command} {
+    list [catch {dict filter {a b}} msg] $msg
+} {1 {wrong # args: should be "dict filter dictionary filterType ..."}}
+test dict-17.22 {dict filter command} {
+    list [catch {dict filter {a b} JUNK} msg] $msg
+} {1 {bad filterType "JUNK": must be key, script, or value}}
+test dict-17.23 {dict filter command} {
+    list [catch {dict filter a key *} msg] $msg
+} {1 {missing value to go with key}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End: