diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | doc/DictObj.3 | 32 | ||||
| -rw-r--r-- | doc/dict.n | 8 | ||||
| -rw-r--r-- | generic/tcl.h | 9 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 208 | ||||
| -rw-r--r-- | tests/dict.test | 8 |
6 files changed, 172 insertions, 102 deletions
@@ -1,3 +1,12 @@ +2004-10-02 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclDictObj.c (TraceDictPath, Tcl_DictObjPutKeyList): Add + support for automatic creation of dictionary paths since that is + what everyone seems to actually expect of the API! + (Tcl_DictObjNext): Make calling this after Tcl_DictObjDone non-fatal + as that simplifies a number of internal APIs. This doesn't break any + existing working code as it is a case which previously caused a panic. + 2004-10-02 Don Porter <dgp@users.sourceforge.net> * tests/namespace.test (namespace-8.7): Another test for save/restore diff --git a/doc/DictObj.3 b/doc/DictObj.3 index 93291f7..01e20cf 100644 --- a/doc/DictObj.3 +++ b/doc/DictObj.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: DictObj.3,v 1.4 2004/09/18 17:01:05 dkf Exp $ +'\" RCS: @(#) $Id: DictObj.3,v 1.5 2004/10/02 17:00:38 dkf Exp $ '\" .so man.macros .TH Tcl_DictObj 3 8.5 Tcl "Tcl Library Procedures" @@ -161,9 +161,11 @@ If the last call to \fBTcl_DictObjFirst\fR or \fBTcl_DictObjNext\fR \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. \fBTcl_DictObjDone\fR \fImust not\fR -be called if either \fBTcl_DictObjFirst\fR or \fBTcl_DictObjNext\fR -set the variable pointed to by \fIdonePtr\fR to 1. +held by the searching process. If \fBTcl_DictObjNext\fR is called on +a particular \fIsearchPtr\fR after \fBTcl_DictObjDone\fR is called on +it, the variable pointed to by \fIdonePtr\fR will always be set to 1 +(and nothing else will happen). It is safe to call +\fBTcl_DictObjDone\fR multiple times on the same \fIsearchPtr\fR. .PP The procedures \fBTcl_DictObjPutKeyList\fR and \fBTcl_DictObjRemoveKeyList\fR are the close analogues of @@ -175,7 +177,10 @@ stored as values inside outer dictionaries. The \fIkeyc\fR and 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. +\fBTcl_DictObjGet\fR. With \fBTcl_DictObjPutKeyList\fR, nested +dictionaries are created for non-terminal keys where they do not +already exist. With \fBTcl_DictObjRemoveKeyList\fR, all non-terminal +keys must exist and have dictionaries as their values. .SH EXAMPLE Using the dictionary iteration interface to search determine if there is a key that maps to itself: @@ -193,37 +198,28 @@ int done; * reference count management is also used. The lock is * released automatically when the loop is finished, but must * be released manually when an exceptional exit from the loop - * is performed. + * is performed. However it is safe to try to release the lock + * even if we've finished iterating over the loop. */ if (Tcl_DictObjFirst(interp, objPtr, &search, &key, &value, &done) != TCL_OK) { return TCL_ERROR; } for (; done ; Tcl_DictObjNext(&search, &key, &value, &done)) { - /* * Note that strcmp() is not a good way of comparing * objects and is just used here for demonstration * purposes. */ if (!strcmp(Tcl_GetString(key), Tcl_GetString(value))) { - - /* - * We jump out of the loop, so we must release the - * lock on the object representation that the iterator - * is currently holding. - */ - Tcl_DictObjDone(&search); - break; } } -/* - * Note, *no* call to Tcl_DictObjDone() here! - */ +Tcl_DictObjDone(&search); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!done)); return TCL_OK; .CE + .SH "SEE ALSO" Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_InitObjHashTable .SH KEYWORDS @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: dict.n,v 1.6 2004/09/18 17:01:06 dkf Exp $ +'\" RCS: @(#) $Id: dict.n,v 1.7 2004/10/02 17:00:38 dkf Exp $ '\" .so man.macros .TH dict n 8.5 Tcl "Tcl Built-In Commands" @@ -157,9 +157,9 @@ key but no value. \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. +containing a mapping from the given key to the given value. When +multiple keys are present, this operation creates or updates a chain +of nested dictionaries. .TP \fBdict size \fIdictionaryValue\fR Return the number of key/value mappings in the given dictionary value. diff --git a/generic/tcl.h b/generic/tcl.h index a697ade..4a285d0 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.183 2004/09/10 19:54:06 andreas_kupries Exp $ + * RCS: @(#) $Id: tcl.h,v 1.184 2004/10/02 17:00:38 dkf Exp $ */ #ifndef _TCL @@ -1339,9 +1339,10 @@ typedef struct Tcl_HashSearch { */ typedef struct { - Tcl_HashSearch search; - int epoch; - Tcl_Dict dictionaryPtr; + Tcl_HashSearch search; /* Search struct for underlying hash table. */ + int epoch; /* Epoch marker for dictionary being searched, + * or -1 if search has terminated. */ + Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */ } Tcl_DictSearch; diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 327fb92..046a6de 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,14 +9,22 @@ * 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.18 2004/09/29 22:17:31 dkf Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.19 2004/10/02 17:00:39 dkf Exp $ */ #include "tclInt.h" /* + * Forward declaration. + */ +struct Dict; + +/* * Flag values for TraceDictPath(). * + * DICT_PATH_READ indicates that all entries on the path must exist + * but no updates will be needed. + * * DICT_PATH_UPDATE indicates that we are going to be doing an update * at the tip of the path, so duplication of shared objects should be * done along the way. @@ -25,10 +33,16 @@ * and a lookup failure should therefore not be an error. If (and * only if) this flag is set, TraceDictPath() will return the special * value DICT_PATH_NON_EXISTENT if the path is not traceable. + * + * DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to + * be set) indicates that we are to create non-existant dictionaries + * on the path. */ +#define DICT_PATH_READ 0 #define DICT_PATH_UPDATE 1 #define DICT_PATH_EXISTS 2 +#define DICT_PATH_CREATE 5 #define DICT_PATH_NON_EXISTENT ((Tcl_Obj *) (void *) 1) @@ -36,6 +50,7 @@ * Prototypes for procedures defined later in this file: */ +static void DeleteDict _ANSI_ARGS_((struct Dict *dict)); static int DictAppendCmd _ANSI_ARGS_((Tcl_Interp *interp, int objc, Tcl_Obj *CONST *objv)); static int DictCreateCmd _ANSI_ARGS_((Tcl_Interp *interp, @@ -76,12 +91,10 @@ static void FreeDictInternalRep _ANSI_ARGS_((Tcl_Obj *dictPtr)); static void InvalidateDictChain _ANSI_ARGS_((Tcl_Obj *dictObj)); 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 flags)); -struct Dict; -static void DeleteDict _ANSI_ARGS_((struct Dict *dict)); +static void UpdateStringOfDict _ANSI_ARGS_((Tcl_Obj *dictPtr)); /* * Internal representation of a dictionary. @@ -192,11 +205,11 @@ DupDictInternalRep(srcPtr, copyPtr) * 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. + * Frees the memory holding the dictionary's internal hash table + * unless it is locked by an iteration going over it. * *---------------------------------------------------------------------- + */ static void @@ -213,6 +226,26 @@ FreeDictInternalRep(dictPtr) dictPtr->internalRep.otherValuePtr = NULL; /* Belt and braces! */ } +/* + *---------------------------------------------------------------------- + * + * DeleteDict -- + * + * Delete the structure that is used to implement a dictionary's + * internal representation. Called when either the dictionary + * object loses its internal representation or when the last + * iteration over the dictionary completes. + * + * Results: + * None + * + * Side effects: + * Decrements the reference count of all key and value objects in + * the dictionary, which may free them. + * + *---------------------------------------------------------------------- + */ + static void DeleteDict(dict) Dict *dict; @@ -554,16 +587,17 @@ SetDictFromAny(interp, objPtr) * 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.) + * given. If the flags argument has the DICT_PATH_UPDATE 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. If the flags argument is DICT_PATH_EXISTS, - * a non-existent path gives a DICT_PATH_NON_EXISTENT result. + * 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. If the flags argument + * has the DICT_PATH_EXISTS set, a non-existent path gives a + * DICT_PATH_NON_EXISTENT result. * * Side effects: * If the flags argument is zero or DICT_PATH_EXISTS, there are @@ -572,8 +606,11 @@ SetDictFromAny(interp, objPtr) * 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.) + * dictionaries (for easy invalidation of string representations + * using InvalidateDictChain.) If the flags argument has the + * DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit), + * non-existant keys will be inserted with a value of an empty + * dictionary, resulting in the path being built. * *---------------------------------------------------------------------- */ @@ -593,7 +630,7 @@ TraceDictPath(interp, dictPtr, keyc, keyv, flags) } } dict = (Dict *) dictPtr->internalRep.otherValuePtr; - if (flags == DICT_PATH_UPDATE) { + if (flags & DICT_PATH_UPDATE) { dict->chain = NULL; } @@ -602,26 +639,38 @@ TraceDictPath(interp, dictPtr, keyc, keyv, flags) Tcl_Obj *tmpObj; if (hPtr == NULL) { - if (flags == DICT_PATH_EXISTS) { + int isNew; /* Dummy */ + if (flags & DICT_PATH_EXISTS) { return DICT_PATH_NON_EXISTENT; } - if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "key \"", TclGetString(keyv[i]), - "\" not known in dictionary", NULL); + if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) { + if (interp != NULL) { + Tcl_ResetResult(interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "key \"", TclGetString(keyv[i]), + "\" not known in dictionary", NULL); + } + return NULL; } - return NULL; - } - tmpObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr); - if (tmpObj->typePtr != &tclDictType) { - if (SetDictFromAny(interp, tmpObj) != TCL_OK) { - return NULL; + /* + * The next line should always set isNew to 1. + */ + hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyv[i], &isNew); + tmpObj = Tcl_NewDictObj(); + Tcl_IncrRefCount(tmpObj); + Tcl_SetHashValue(hPtr, (ClientData) tmpObj); + } else { + tmpObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr); + if (tmpObj->typePtr != &tclDictType) { + if (SetDictFromAny(interp, tmpObj) != TCL_OK) { + return NULL; + } } } + newDict = (Dict *) tmpObj->internalRep.otherValuePtr; - if (flags == DICT_PATH_UPDATE) { + if (flags & DICT_PATH_UPDATE) { if (Tcl_IsShared(tmpObj)) { Tcl_DecrRefCount(tmpObj); tmpObj = Tcl_DuplicateObj(tmpObj); @@ -638,6 +687,27 @@ TraceDictPath(interp, dictPtr, keyc, keyv, flags) } return dictPtr; } + +/* + *---------------------------------------------------------------------- + * + * InvalidateDictChain -- + * + * Go through a dictionary chain (built by an updating invokation + * of TraceDictPath) and invalidate the string representations of + * all the dictionaries on the chain. + * + * Results: + * None + * + * Side effects: + * String reps are invalidated and epoch counters (for detecting + * illegal concurrent modifications) are updated through the + * chain of updated dictionaries. + * + *---------------------------------------------------------------------- + */ + static void InvalidateDictChain(dictObj) Tcl_Obj *dictObj; @@ -645,11 +715,10 @@ InvalidateDictChain(dictObj) Dict *dict = (Dict *) dictObj->internalRep.otherValuePtr; do { - if (dictObj->bytes != NULL) { - Tcl_InvalidateStringRep(dictObj); - } + Tcl_InvalidateStringRep(dictObj); dict->epoch++; - if ((dictObj = dict->chain) == NULL) { + dictObj = dict->chain; + if (dictObj == NULL) { break; } dict->chain = NULL; @@ -901,6 +970,7 @@ Tcl_DictObjFirst(interp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr) dict = (Dict *) dictPtr->internalRep.otherValuePtr; hPtr = Tcl_FirstHashEntry(&dict->table, &searchPtr->search); if (hPtr == NULL) { + searchPtr->epoch = -1; *donePtr = 1; } else { *donePtr = 0; @@ -957,6 +1027,14 @@ Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr) Tcl_HashEntry *hPtr; /* + * If the searh is done; we do no work. + */ + if (searchPtr->epoch == -1) { + *donePtr = 1; + return; + } + + /* * Bail out if the dictionary has had any elements added, modified * or removed. This *shouldn't* happen, but... */ @@ -1054,7 +1132,7 @@ Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr) Tcl_Panic("Tcl_DictObjPutKeyList called with empty key list"); } - dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_UPDATE); + dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_CREATE); if (dictPtr == NULL) { return TCL_ERROR; } @@ -1344,7 +1422,7 @@ DictGetCmd(interp, objc, objv) * going through a chain of searches.) Note that this loop always * executes at least once. */ - dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, 0); + dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, DICT_PATH_READ); if (dictPtr == NULL) { return TCL_ERROR; } @@ -2181,7 +2259,6 @@ DictForCmd(interp, objc, objv) return TCL_ERROR; } if (varc != 2) { - Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "must have exactly two variable names", NULL); return TCL_ERROR; @@ -2207,11 +2284,7 @@ DictForCmd(interp, objc, objv) 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; + goto doneFor; } while (!done) { @@ -2220,56 +2293,45 @@ DictForCmd(interp, objc, objv) * the key variable. */ Tcl_IncrRefCount(valueObj); - if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, - TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) { Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set key variable: \"", - Tcl_GetString(keyVarObj), "\"", (char *) NULL); + TclGetString(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; + result = TCL_ERROR; + goto doneFor; } Tcl_DecrRefCount(valueObj); - if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, - TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) { Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set value variable: \"", - Tcl_GetString(keyVarObj), "\"", (char *) NULL); - goto errorExit; + TclGetString(valueVarObj), "\"", (char *) NULL); + result = TCL_ERROR; + goto doneFor; } result = Tcl_EvalObjEx(interp, scriptObj, 0); - if (result != TCL_OK) { - if (result == TCL_CONTINUE) { - result = TCL_OK; - } else if (result == TCL_BREAK) { + if (result == TCL_CONTINUE) { + result = TCL_OK; + } else if (result != TCL_OK) { + if (result == TCL_BREAK) { result = TCL_OK; - Tcl_DictObjDone(&search); - break; } else if (result == TCL_ERROR) { - char msg[32 + TCL_INTEGER_SPACE]; + 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; } + break; } Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } + doneFor: /* * Stop holding a reference to these objects. */ @@ -2278,6 +2340,7 @@ DictForCmd(interp, objc, objv) Tcl_DecrRefCount(dictObj); Tcl_DecrRefCount(scriptObj); + Tcl_DictObjDone(&search); if (result == TCL_OK) { Tcl_ResetResult(interp); } @@ -2565,7 +2628,7 @@ DictFilterCmd(interp, objc, objv) Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set key variable: \"", - Tcl_GetString(keyVarObj), "\"", (char *) NULL); + TclGetString(keyVarObj), "\"", (char *) NULL); result = TCL_ERROR; goto abnormalResult; } @@ -2574,7 +2637,7 @@ DictFilterCmd(interp, objc, objv) Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set value variable: \"", - Tcl_GetString(keyVarObj), "\"", (char *) NULL); + TclGetString(valueVarObj), "\"", (char *) NULL); goto abnormalResult; } @@ -2605,7 +2668,7 @@ DictFilterCmd(interp, objc, objv) Tcl_ResetResult(interp); Tcl_DictObjDone(&search); result = TCL_OK; - goto normalResult; + break; case TCL_ERROR: sprintf(msg, "\n (\"dict filter\" script line %d)", interp->errorLine); @@ -2628,6 +2691,7 @@ DictFilterCmd(interp, objc, objv) Tcl_DecrRefCount(valueVarObj); Tcl_DecrRefCount(dictObj); Tcl_DecrRefCount(scriptObj); + Tcl_DictObjDone(&search); if (result == TCL_OK) { Tcl_SetObjResult(interp, resultObj); diff --git a/tests/dict.test b/tests/dict.test index 215c327..1318d57 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dict.test,v 1.7 2004/03/12 23:21:06 dkf Exp $ +# RCS: @(#) $Id: dict.test,v 1.8 2004/10/02 17:00:39 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -538,10 +538,10 @@ 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} { +test dict-15.7 {dict set command: path creation} { set dictVar {} - list [catch {dict set dictVar a b x} msg] $msg -} {1 {key "a" not known in dictionary}} + dict set dictVar a b x +} {a {b x}} test dict-15.8 {dict set command: creates variables} { catch {unset dictVar} dict set dictVar a x |