diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 439 |
2 files changed, 384 insertions, 60 deletions
@@ -1,3 +1,8 @@ +2004-10-08 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclDictObj.c (DictUpdateCmd,DictWithCmd): Core of + implementation of TIP#212; docs and tests still to do... + 2004-10-07 Don Porter <dgp@users.sourceforge.net> * generic/tclTest.c (TestsetobjerrorcodeCmd): Simplified. diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 7b5007c..9fadc83 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.21 2004/10/06 05:52:21 dgp Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.22 2004/10/08 15:05:05 dkf Exp $ */ #include "tclInt.h" @@ -85,6 +85,10 @@ 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 int DictUpdateCmd _ANSI_ARGS_((Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv)); +static int DictWithCmd _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)); @@ -262,7 +266,7 @@ DeleteDict(dict) for (hPtr=Tcl_FirstHashEntry(&dict->table,&search); hPtr!=NULL; hPtr=Tcl_NextHashEntry(&search)) { valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); } Tcl_DeleteHashTable(&dict->table); ckfree((char *) dict); @@ -447,7 +451,7 @@ SetDictFromAny(interp, objPtr) hPtr = Tcl_CreateHashEntry(&dict->table, (char *)objv[i], &isNew); if (!isNew) { Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(discardedValue); + TclDecrRefCount(discardedValue); } Tcl_SetHashValue(hPtr, (ClientData) objv[i+1]); Tcl_IncrRefCount(objv[i+1]); /* since hash now holds ref to it */ @@ -511,7 +515,7 @@ SetDictFromAny(interp, objPtr) result = TclFindElement(interp, p, lenRemain, &elemStart, &nextElem, &elemSize, &hasBrace); if (result != TCL_OK) { - Tcl_DecrRefCount(keyPtr); + TclDecrRefCount(keyPtr); goto errorExit; } if (elemStart >= limit) { @@ -541,8 +545,8 @@ SetDictFromAny(interp, objPtr) hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew); if (!isNew) { Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(keyPtr); - Tcl_DecrRefCount(discardedValue); + TclDecrRefCount(keyPtr); + TclDecrRefCount(discardedValue); } Tcl_SetHashValue(hPtr, (ClientData) valuePtr); Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */ @@ -568,13 +572,13 @@ SetDictFromAny(interp, objPtr) Tcl_SetObjResult(interp, Tcl_NewStringObj("missing value to go with key", -1)); } - Tcl_DecrRefCount(keyPtr); + TclDecrRefCount(keyPtr); result = TCL_ERROR; errorExit: for (hPtr=Tcl_FirstHashEntry(&dict->table,&search); hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); } Tcl_DeleteHashTable(&dict->table); ckfree((char *) dict); @@ -671,7 +675,7 @@ TraceDictPath(interp, dictPtr, keyc, keyv, flags) newDict = (Dict *) tmpObj->internalRep.otherValuePtr; if (flags & DICT_PATH_UPDATE) { if (Tcl_IsShared(tmpObj)) { - Tcl_DecrRefCount(tmpObj); + TclDecrRefCount(tmpObj); tmpObj = Tcl_DuplicateObj(tmpObj); Tcl_IncrRefCount(tmpObj); Tcl_SetHashValue(hPtr, (ClientData) tmpObj); @@ -772,7 +776,7 @@ Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr) Tcl_IncrRefCount(valuePtr); if (!isNew) { Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(oldValuePtr); + TclDecrRefCount(oldValuePtr); } Tcl_SetHashValue(hPtr, valuePtr); dict->epoch++; @@ -870,7 +874,7 @@ Tcl_DictObjRemove(interp, dictPtr, keyPtr) if (hPtr != NULL) { Tcl_Obj *valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); Tcl_DeleteHashEntry(hPtr); dict->epoch++; } @@ -1141,7 +1145,7 @@ Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr) Tcl_IncrRefCount(valuePtr); if (!isNew) { Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(oldValuePtr); + TclDecrRefCount(oldValuePtr); } Tcl_SetHashValue(hPtr, valuePtr); InvalidateDictChain(dictPtr); @@ -1196,7 +1200,7 @@ Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv) hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[keyc-1]); if (hPtr != NULL) { Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr); - Tcl_DecrRefCount(oldValuePtr); + TclDecrRefCount(oldValuePtr); Tcl_DeleteHashEntry(hPtr); } InvalidateDictChain(dictPtr); @@ -1421,6 +1425,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, DICT_PATH_READ); if (dictPtr == NULL) { return TCL_ERROR; @@ -1481,7 +1486,7 @@ DictReplaceCmd(interp, objc, objv) result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]); if (result != TCL_OK) { if (allocatedDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } return TCL_ERROR; } @@ -1532,7 +1537,7 @@ DictRemoveCmd(interp, objc, objv) result = Tcl_DictObjRemove(interp, dictPtr, objv[i]); if (result != TCL_OK) { if (allocatedDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } return TCL_ERROR; } @@ -1604,7 +1609,7 @@ DictMergeCmd(interp, objc, objv) if (Tcl_DictObjFirst(interp, objv[i], &search, &keyObj, &valueObj, &done) != TCL_OK) { if (allocatedDict) { - Tcl_DecrRefCount(targetObj); + TclDecrRefCount(targetObj); } return TCL_ERROR; } @@ -1613,7 +1618,7 @@ DictMergeCmd(interp, objc, objv) keyObj, valueObj) != TCL_OK) { Tcl_DictObjDone(&search); if (allocatedDict) { - Tcl_DecrRefCount(targetObj); + TclDecrRefCount(targetObj); } return TCL_ERROR; } @@ -1941,7 +1946,7 @@ DictIncrCmd(interp, objc, objv) if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) { if (allocatedDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } return TCL_ERROR; } @@ -1999,7 +2004,7 @@ DictIncrCmd(interp, objc, objv) result = Tcl_GetWideIntFromObj(interp, valuePtr, &wValue); if (result != TCL_OK) { if (allocatedDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } return result; } @@ -2039,9 +2044,9 @@ DictIncrCmd(interp, objc, objv) * from above to be a valid dictionary. */ if (allocatedDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); return TCL_ERROR; } } @@ -2049,7 +2054,7 @@ DictIncrCmd(interp, objc, objv) Tcl_IncrRefCount(dictPtr); resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG); - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); if (resultPtr == NULL) { return TCL_ERROR; } @@ -2100,7 +2105,7 @@ DictLappendCmd(interp, objc, objv) if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) { if (allocatedDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } return TCL_ERROR; } @@ -2118,10 +2123,10 @@ DictLappendCmd(interp, objc, objv) if (Tcl_ListObjAppendElement(interp, valuePtr, objv[i]) != TCL_OK) { if (allocatedValue) { - Tcl_DecrRefCount(valuePtr); + TclDecrRefCount(valuePtr); } if (allocatedDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } return TCL_ERROR; } @@ -2137,7 +2142,7 @@ DictLappendCmd(interp, objc, objv) Tcl_IncrRefCount(dictPtr); resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG); - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); if (resultPtr == NULL) { return TCL_ERROR; } @@ -2188,7 +2193,7 @@ DictAppendCmd(interp, objc, objv) if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) { if (allocatedDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } return TCL_ERROR; } @@ -2210,7 +2215,7 @@ DictAppendCmd(interp, objc, objv) Tcl_IncrRefCount(dictPtr); resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG); - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); if (resultPtr == NULL) { return TCL_ERROR; } @@ -2295,11 +2300,11 @@ DictForCmd(interp, objc, objv) Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't set key variable: \"", TclGetString(keyVarObj), "\"", (char *) NULL); - Tcl_DecrRefCount(valueObj); + TclDecrRefCount(valueObj); result = TCL_ERROR; goto doneFor; } - Tcl_DecrRefCount(valueObj); + TclDecrRefCount(valueObj); if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't set value variable: \"", @@ -2331,10 +2336,10 @@ DictForCmd(interp, objc, objv) /* * Stop holding a reference to these objects. */ - Tcl_DecrRefCount(keyVarObj); - Tcl_DecrRefCount(valueVarObj); - Tcl_DecrRefCount(dictObj); - Tcl_DecrRefCount(scriptObj); + TclDecrRefCount(keyVarObj); + TclDecrRefCount(valueVarObj); + TclDecrRefCount(dictObj); + TclDecrRefCount(scriptObj); Tcl_DictObjDone(&search); if (result == TCL_OK) { @@ -2388,7 +2393,7 @@ DictSetCmd(interp, objc, objv) objv[objc-1]); if (result != TCL_OK) { if (allocatedDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } return TCL_ERROR; } @@ -2396,7 +2401,7 @@ DictSetCmd(interp, objc, objv) Tcl_IncrRefCount(dictPtr); resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG); - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); if (resultPtr == NULL) { return TCL_ERROR; } @@ -2448,7 +2453,7 @@ DictUnsetCmd(interp, objc, objv) result = Tcl_DictObjRemoveKeyList(interp, dictPtr, objc-3, objv+3); if (result != TCL_OK) { if (allocatedDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } return TCL_ERROR; } @@ -2456,7 +2461,7 @@ DictUnsetCmd(interp, objc, objv) Tcl_IncrRefCount(dictPtr); resultPtr = Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, TCL_LEAVE_ERR_MSG); - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); if (resultPtr == NULL) { return TCL_ERROR; } @@ -2602,10 +2607,10 @@ DictFilterCmd(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); + TclDecrRefCount(keyVarObj); + TclDecrRefCount(valueVarObj); + TclDecrRefCount(dictObj); + TclDecrRefCount(scriptObj); return TCL_ERROR; } @@ -2642,11 +2647,11 @@ DictFilterCmd(interp, objc, objv) Tcl_ResetResult(interp); if (Tcl_GetBooleanFromObj(interp, boolObj, &satisfied) != TCL_OK) { - Tcl_DecrRefCount(boolObj); + TclDecrRefCount(boolObj); result = TCL_ERROR; goto abnormalResult; } - Tcl_DecrRefCount(boolObj); + TclDecrRefCount(boolObj); if (satisfied) { Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); } @@ -2670,8 +2675,8 @@ DictFilterCmd(interp, objc, objv) goto abnormalResult; } - Tcl_DecrRefCount(keyObj); - Tcl_DecrRefCount(valueObj); + TclDecrRefCount(keyObj); + TclDecrRefCount(valueObj); Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } @@ -2679,16 +2684,16 @@ DictFilterCmd(interp, objc, objv) /* * Stop holding a reference to these objects. */ - Tcl_DecrRefCount(keyVarObj); - Tcl_DecrRefCount(valueVarObj); - Tcl_DecrRefCount(dictObj); - Tcl_DecrRefCount(scriptObj); + TclDecrRefCount(keyVarObj); + TclDecrRefCount(valueVarObj); + TclDecrRefCount(dictObj); + TclDecrRefCount(scriptObj); Tcl_DictObjDone(&search); if (result == TCL_OK) { Tcl_SetObjResult(interp, resultObj); } else { - Tcl_DecrRefCount(resultObj); + TclDecrRefCount(resultObj); } return result; } @@ -2698,13 +2703,323 @@ DictFilterCmd(interp, objc, objv) 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); + TclDecrRefCount(keyObj); + TclDecrRefCount(valueObj); + TclDecrRefCount(keyVarObj); + TclDecrRefCount(valueVarObj); + TclDecrRefCount(dictObj); + TclDecrRefCount(scriptObj); + TclDecrRefCount(resultObj); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * DictUpdateCmd -- + * + * This function implements the "dict update" Tcl command. + * See the user documentation for details on what it does, and + * TIP#323 for the formal specification. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +DictUpdateCmd(interp, objc, objv) + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST *objv; +{ + Tcl_Obj *dictPtr, *objPtr; + int i, result, dummy, allocdict = 0; + Tcl_SavedResult sr; + + if (objc < 6 || objc & 1) { + Tcl_WrongNumArgs(interp, 2, objv, + "varName key varName ?key varName ...? script"); + return TCL_ERROR; + } + + dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, TCL_LEAVE_ERR_MSG); + if (dictPtr == NULL) { + return TCL_ERROR; + } + if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) { + return TCL_ERROR; + } + Tcl_IncrRefCount(dictPtr); + for (i=3 ; i+2<objc ; i+=2) { + if (Tcl_DictObjGet(interp, dictPtr, objv[i], &objPtr) != TCL_OK) { + TclDecrRefCount(dictPtr); + return TCL_ERROR; + } + if (objPtr == NULL) { + /* ??? */ + Tcl_UnsetVar(interp, Tcl_GetString(objv[i+1]), 0); + } else if (Tcl_ObjSetVar2(interp, objv[i+1], NULL, objPtr, + TCL_LEAVE_ERR_MSG) == NULL) { + TclDecrRefCount(dictPtr); + return TCL_ERROR; + } + } + TclDecrRefCount(dictPtr); + + /* + * Execute the body. + */ + + result = Tcl_EvalObj(interp, objv[objc-1]); + if (result == TCL_ERROR) { + Tcl_AddErrorInfo(interp, "\n (body of \"dict update\")"); + } + + /* + * If the dictionary variable doesn't exist, drop everything + * silently. + */ + + dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); + if (dictPtr == NULL) { + return TCL_OK; + } + + /* + * Double-check that it is still a dictionary. + */ + + Tcl_SaveResult(interp, &sr); + if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) { + Tcl_DiscardResult(&sr); + return TCL_ERROR; + } + + if (Tcl_IsShared(dictPtr)) { + dictPtr = Tcl_DuplicateObj(dictPtr); + allocdict = 1; + } + + /* + * Write back the values from the variables, treating failure to + * read as an instruction to remove the key. + */ + + for (i=3 ; i+2<objc ; i+=2) { + objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0); + if (objPtr == NULL) { + Tcl_DictObjRemove(interp, dictPtr, objv[i]); + } else { + /* Shouldn't fail */ + Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr); + } + } + + /* + * Write the dictionary back to its variable. + */ + + if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, + TCL_LEAVE_ERR_MSG) != TCL_OK) { + Tcl_DiscardResult(&sr); + if (allocdict) { + TclDecrRefCount(dictPtr); + } + return TCL_ERROR; + } + + Tcl_RestoreResult(interp, &sr); + return result; +} + +/* + *---------------------------------------------------------------------- + * + * DictWithCmd -- + * + * This function implements the "dict with" Tcl command. + * See the user documentation for details on what it does, and + * TIP#323 for the formal specification. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +DictWithCmd(interp, objc, objv) + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST *objv; +{ + Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr; + Tcl_DictSearch s; + Tcl_SavedResult sr; + int done, result, keyc, i, allocdict=0; + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, "dictVar ?key ...? script"); + return TCL_ERROR; + } + + /* + * Get the dictionary to open out. + */ + + dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, TCL_LEAVE_ERR_MSG); + if (dictPtr == NULL) { + return TCL_ERROR; + } + if (objc > 4) { + dictPtr = TraceDictPath(interp, dictPtr, objc-4, objv+3, + DICT_PATH_READ); + if (dictPtr == NULL) { + return TCL_ERROR; + } + } + + /* + * Go over the list of keys and write each corresponding value to + * a variable in the current context with the same name. Also + * keep a copy of the keys so we can write back properly later on + * even if the dictionary has been structurally modified. + */ + + if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr, + &done) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_IncrRefCount(dictPtr); + TclNewObj(keysPtr); + Tcl_IncrRefCount(keysPtr); + + for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) { + Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr); + if (Tcl_ObjSetVar2(interp, keyPtr, NULL, valPtr, + TCL_LEAVE_ERR_MSG) == NULL) { + TclDecrRefCount(dictPtr); + TclDecrRefCount(keysPtr); + Tcl_DictObjDone(&s); + return TCL_ERROR; + } + } + TclDecrRefCount(dictPtr); + + /* + * Execute the body. + */ + + result = Tcl_EvalObjEx(interp, objv[objc-1], 0); + if (result == TCL_ERROR) { + Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")"); + } + + /* + * If the dictionary variable doesn't exist, drop everything + * silently. + */ + + dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); + if (dictPtr == NULL) { + TclDecrRefCount(keysPtr); + return result; + } + + /* + * Double-check that it is still a dictionary. + */ + + Tcl_SaveResult(interp, &sr); + if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) { + TclDecrRefCount(keysPtr); + Tcl_DiscardResult(&sr); + return TCL_ERROR; + } + + if (Tcl_IsShared(dictPtr)) { + dictPtr = Tcl_DuplicateObj(dictPtr); + allocdict = 1; + } + + if (objc > 4) { + /* + * Want to get to the dictionary which we will update; need to + * do prepare-for-update de-sharing along the path *but* avoid + * generating an error on a non-existant path (we'll treat + * that the same as a non-existant variable. Luckily, the + * de-sharing operation isn't deeply damaging if we don't go + * on to update; it's just less than perfectly efficient (but + * no memory should be leaked). + */ + leafPtr = TraceDictPath(interp, dictPtr, objc-4, objv+3, + DICT_PATH_EXISTS | DICT_PATH_UPDATE); + if (leafPtr == NULL) { + TclDecrRefCount(keysPtr); + if (allocdict) { + TclDecrRefCount(dictPtr); + } + Tcl_DiscardResult(&sr); + return TCL_ERROR; + } + if (leafPtr == DICT_PATH_NON_EXISTENT) { + TclDecrRefCount(keysPtr); + if (allocdict) { + TclDecrRefCount(dictPtr); + } + Tcl_RestoreResult(interp, &sr); + return TCL_OK; + } + } else { + leafPtr = dictPtr; + } + + /* + * Now process our updates on the leaf dictionary. + */ + + Tcl_ListObjGetElements(NULL, keysPtr, &keyc, &keyv); + for (i=0 ; i<keyc ; i++) { + valPtr = Tcl_ObjGetVar2(interp, keyv[i], NULL, 0); + if (valPtr == NULL) { + Tcl_DictObjRemove(NULL, leafPtr, keyv[i]); + } else { + Tcl_DictObjPut(NULL, leafPtr, keyv[i], valPtr); + } + } + TclDecrRefCount(keysPtr); + + /* + * Ensure that none of the dictionaries in the chain still have a + * string rep. + */ + + if (objc > 4) { + InvalidateDictChain(leafPtr); + } + + /* + * Write back the outermost dictionary to the variable. + */ + + if (Tcl_ObjSetVar2(interp, objv[2], NULL, dictPtr, + TCL_LEAVE_ERR_MSG) == NULL) { + if (allocdict) { + TclDecrRefCount(dictPtr); + } + Tcl_DiscardResult(&sr); + return TCL_ERROR; + } + Tcl_RestoreResult(interp, &sr); return result; } @@ -2736,12 +3051,14 @@ Tcl_DictObjCmd(/*ignored*/ clientData, interp, objc, objv) static CONST char *subcommands[] = { "append", "create", "exists", "filter", "for", "get", "incr", "info", "keys", "lappend", "merge", - "remove", "replace", "set", "size", "unset", "values", NULL + "remove", "replace", "set", "size", "unset", + "update", "values", "with", NULL }; enum DictSubcommands { DICT_APPEND, DICT_CREATE, DICT_EXISTS, DICT_FILTER, DICT_FOR, DICT_GET, DICT_INCR, DICT_INFO, DICT_KEYS, DICT_LAPPEND, DICT_MERGE, - DICT_REMOVE, DICT_REPLACE, DICT_SET, DICT_SIZE, DICT_UNSET, DICT_VALUES + DICT_REMOVE, DICT_REPLACE, DICT_SET, DICT_SIZE, DICT_UNSET, + DICT_UPDATE, DICT_VALUES, DICT_WITH }; int index; @@ -2770,7 +3087,9 @@ Tcl_DictObjCmd(/*ignored*/ clientData, 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_UPDATE: return DictUpdateCmd(interp, objc, objv); case DICT_VALUES: return DictValuesCmd(interp, objc, objv); + case DICT_WITH: return DictWithCmd(interp, objc, objv); } Tcl_Panic("unexpected fallthrough!"); /* |