summaryrefslogtreecommitdiffstats
path: root/generic/tclDictObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclDictObj.c')
-rw-r--r--generic/tclDictObj.c506
1 files changed, 346 insertions, 160 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 593108f..ba4dd69 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -4,7 +4,7 @@
* This file contains functions that implement the Tcl dict object type
* and its accessor command.
*
- * Copyright (c) 2002 by Donal K. Fellows.
+ * Copyright (c) 2002-2010 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.
@@ -31,8 +31,6 @@ static int DictExistsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
static int DictFilterCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
-static int DictForCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const *objv);
static int DictGetCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
static int DictIncrCmd(ClientData dummy, Tcl_Interp *interp,
@@ -72,32 +70,41 @@ static inline void DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
Tcl_Obj *keyPtr, int *newPtr);
static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
+static int FinalizeDictUpdate(ClientData data[],
+ Tcl_Interp *interp, int result);
+static int FinalizeDictWith(ClientData data[],
+ Tcl_Interp *interp, int result);
+static int DictForNRCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictForLoopCallback(ClientData data[],
+ Tcl_Interp *interp, int result);
+
/*
* Table of dict subcommand names and implementations.
*/
static const EnsembleImplMap implementationMap[] = {
- {"append", DictAppendCmd, TclCompileDictAppendCmd },
- {"create", DictCreateCmd, NULL },
- {"exists", DictExistsCmd, NULL },
- {"filter", DictFilterCmd, NULL },
- {"for", DictForCmd, TclCompileDictForCmd },
- {"get", DictGetCmd, TclCompileDictGetCmd },
- {"incr", DictIncrCmd, TclCompileDictIncrCmd },
- {"info", DictInfoCmd, NULL },
- {"keys", DictKeysCmd, NULL },
- {"lappend", DictLappendCmd, TclCompileDictLappendCmd },
- {"merge", DictMergeCmd, NULL },
- {"remove", DictRemoveCmd, NULL },
- {"replace", DictReplaceCmd, NULL },
- {"set", DictSetCmd, TclCompileDictSetCmd },
- {"size", DictSizeCmd, NULL },
- {"unset", DictUnsetCmd, NULL },
- {"update", DictUpdateCmd, TclCompileDictUpdateCmd },
- {"values", DictValuesCmd, NULL },
- {"with", DictWithCmd, NULL },
- {NULL}
+ {"append", DictAppendCmd, TclCompileDictAppendCmd, NULL, NULL, 0 },
+ {"create", DictCreateCmd, NULL, NULL, NULL, 0 },
+ {"exists", DictExistsCmd, NULL, NULL, NULL, 0 },
+ {"filter", DictFilterCmd, NULL, NULL, NULL, 0 },
+ {"for", NULL, TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
+ {"get", DictGetCmd, TclCompileDictGetCmd, NULL, NULL, 0 },
+ {"incr", DictIncrCmd, TclCompileDictIncrCmd, NULL, NULL, 0 },
+ {"info", DictInfoCmd, NULL, NULL, NULL, 0 },
+ {"keys", DictKeysCmd, NULL, NULL, NULL, 0 },
+ {"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 },
+ {"merge", DictMergeCmd, NULL, NULL, NULL, 0 },
+ {"remove", DictRemoveCmd, NULL, NULL, NULL, 0 },
+ {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
+ {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
+ {"size", DictSizeCmd, NULL, NULL, NULL, 0 },
+ {"unset", DictUnsetCmd, NULL, NULL, NULL, 0 },
+ {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
+ {"values", DictValuesCmd, NULL, NULL, NULL, 0 },
+ {"with", DictWithCmd, NULL, NULL, NULL, 0 },
+ {NULL, NULL, NULL, NULL, NULL, 0}
};
/*
@@ -148,10 +155,10 @@ typedef struct Dict {
* functions that can be invoked by generic object code.
*/
-Tcl_ObjType tclDictType = {
+const Tcl_ObjType tclDictType = {
"dict",
FreeDictInternalRep, /* freeIntRepProc */
- DupDictInternalRep, /* dupIntRepProc */
+ DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny /* setFromAnyProc */
};
@@ -166,7 +173,7 @@ Tcl_ObjType tclDictType = {
* *this* file. Everything else should use the dict iterator API.
*/
-static Tcl_HashKeyType chainHashType = {
+static const Tcl_HashKeyType chainHashType = {
TCL_HASH_KEY_TYPE_VERSION,
0,
TclHashObjKey,
@@ -250,7 +257,7 @@ CreateChainEntry(
int *newPtr)
{
ChainEntry *cPtr = (ChainEntry *)
- Tcl_CreateHashEntry(&dict->table, (char *) keyPtr, newPtr);
+ Tcl_CreateHashEntry(&dict->table, keyPtr, newPtr);
/*
* If this is a new entry in the hash table, stitch it into the chain.
@@ -278,7 +285,7 @@ DeleteChainEntry(
Tcl_Obj *keyPtr)
{
ChainEntry *cPtr = (ChainEntry *)
- Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
+ Tcl_FindHashEntry(&dict->table, keyPtr);
if (cPtr == NULL) {
return 0;
@@ -343,7 +350,7 @@ DupDictInternalRep(
InitChainTable(newDict);
for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
- void *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
+ Tcl_Obj *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
int n;
Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n);
@@ -352,7 +359,7 @@ DupDictInternalRep(
* Fill in the contents.
*/
- Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
+ Tcl_SetHashValue(hPtr, valuePtr);
Tcl_IncrRefCount(valuePtr);
}
@@ -396,12 +403,13 @@ FreeDictInternalRep(
{
Dict *dict = dictPtr->internalRep.otherValuePtr;
- --dict->refcount;
+ dict->refcount--;
if (dict->refcount <= 0) {
DeleteDict(dict);
}
dictPtr->internalRep.otherValuePtr = NULL; /* Belt and braces! */
+ dictPtr->typePtr = NULL;
}
/*
@@ -464,7 +472,8 @@ UpdateStringOfDict(
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int numElems, i, length;
- char *elem, *dst;
+ const char *elem;
+ char *dst;
/*
* This field is the most useful one in the whole hash structure, and it
@@ -489,7 +498,7 @@ UpdateStringOfDict(
* elements already.
*/
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
+ keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
dictPtr->length += Tcl_ScanCountedElement(elem, length,
&flagPtr[i]) + 1;
@@ -507,7 +516,7 @@ UpdateStringOfDict(
dictPtr->bytes = ckalloc((unsigned) dictPtr->length);
dst = dictPtr->bytes;
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
+ keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
dst += Tcl_ConvertCountedElement(elem, length, dst,
flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
@@ -555,10 +564,11 @@ SetDictFromAny(
Tcl_Interp *interp,
Tcl_Obj *objPtr)
{
- char *string, *s;
+ const char *string;
+ char *s;
const char *elemStart, *nextElem;
int lenRemain, length, elemSize, hasBrace, result, isNew;
- char *limit; /* Points just after string's last byte. */
+ const char *limit; /* Points just after string's last byte. */
register const char *p;
register Tcl_Obj *keyPtr, *valuePtr;
Dict *dict;
@@ -581,6 +591,7 @@ SetDictFromAny(
if (interp != NULL) {
Tcl_SetResult(interp, "missing value to go with key",
TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
}
return TCL_ERROR;
}
@@ -641,6 +652,9 @@ SetDictFromAny(
result = TclFindElement(interp, p, lenRemain,
&elemStart, &nextElem, &elemSize, &hasBrace);
if (result != TCL_OK) {
+ if (interp != NULL) {
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+ }
goto errorExit;
}
if (elemStart >= limit) {
@@ -661,8 +675,8 @@ SetDictFromAny(
}
TclNewObj(keyPtr);
- keyPtr->bytes = s;
- keyPtr->length = elemSize;
+ keyPtr->bytes = s;
+ keyPtr->length = elemSize;
p = nextElem;
lenRemain = (limit - nextElem);
@@ -673,6 +687,9 @@ SetDictFromAny(
result = TclFindElement(interp, p, lenRemain,
&elemStart, &nextElem, &elemSize, &hasBrace);
if (result != TCL_OK) {
+ if (interp != NULL) {
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+ }
TclDecrRefCount(keyPtr);
goto errorExit;
}
@@ -687,15 +704,15 @@ SetDictFromAny(
s = ckalloc((unsigned) elemSize + 1);
if (hasBrace) {
- memcpy((void *) s, (void *) elemStart, (size_t) elemSize);
+ memcpy(s, elemStart, (size_t) elemSize);
s[elemSize] = 0;
} else {
elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
}
TclNewObj(valuePtr);
- valuePtr->bytes = s;
- valuePtr->length = elemSize;
+ valuePtr->bytes = s;
+ valuePtr->length = elemSize;
/*
* Store key and value in the hash table we're building.
@@ -709,7 +726,7 @@ SetDictFromAny(
TclDecrRefCount(discardedValue);
}
Tcl_SetHashValue(hPtr, valuePtr);
- Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
+ Tcl_IncrRefCount(valuePtr); /* Since hash now holds ref to it. */
}
installHash:
@@ -730,6 +747,7 @@ SetDictFromAny(
missingKey:
if (interp != NULL) {
Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
}
TclDecrRefCount(keyPtr);
result = TCL_ERROR;
@@ -794,7 +812,7 @@ TclTraceDictPath(
}
for (i=0 ; i<keyc ; i++) {
- Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[i]);
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, keyv[i]);
Tcl_Obj *tmpObj;
if (hPtr == NULL) {
@@ -837,7 +855,7 @@ TclTraceDictPath(
TclDecrRefCount(tmpObj);
tmpObj = Tcl_DuplicateObj(tmpObj);
Tcl_IncrRefCount(tmpObj);
- Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
+ Tcl_SetHashValue(hPtr, tmpObj);
dict->epoch++;
newDict = tmpObj->internalRep.otherValuePtr;
}
@@ -984,7 +1002,7 @@ Tcl_DictObjGet(
}
dict = dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
+ hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
if (hPtr == NULL) {
*valuePtrPtr = NULL;
} else {
@@ -1141,8 +1159,7 @@ Tcl_DictObjFirst(
searchPtr->next = cPtr->nextPtr;
dict->refcount++;
if (keyPtrPtr != NULL) {
- *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table,
- &cPtr->entry);
+ *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
}
if (valuePtrPtr != NULL) {
*valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
@@ -1218,7 +1235,7 @@ Tcl_DictObjNext(
searchPtr->next = cPtr->nextPtr;
*donePtr = 0;
if (keyPtrPtr != NULL) {
- *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(
+ *keyPtrPtr = Tcl_GetHashKey(
&((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry);
}
if (valuePtrPtr != NULL) {
@@ -1545,7 +1562,7 @@ DictGetCmd(
int result;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key key ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
return TCL_ERROR;
}
@@ -1556,7 +1573,7 @@ DictGetCmd(
*/
if (objc == 2) {
- Tcl_Obj *keyPtr, *listPtr;
+ Tcl_Obj *keyPtr = NULL, *listPtr;
Tcl_DictSearch search;
int done;
@@ -1601,6 +1618,8 @@ DictGetCmd(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "key \"", TclGetString(objv[objc-1]),
"\" not known in dictionary", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
+ TclGetString(objv[objc-1]), NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, valuePtr);
@@ -1736,7 +1755,7 @@ DictMergeCmd(
int objc,
Tcl_Obj *const *objv)
{
- Tcl_Obj *targetObj, *keyObj, *valueObj;
+ Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL;
int allocatedDict = 0;
int i, done;
Tcl_DictSearch search;
@@ -1826,7 +1845,7 @@ DictKeysCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *listPtr;
- char *pattern = NULL;
+ const char *pattern = NULL;
if (objc!=2 && objc!=3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
@@ -1860,8 +1879,8 @@ DictKeysCmd(
}
} else {
Tcl_DictSearch search;
- Tcl_Obj *keyPtr;
- int done;
+ Tcl_Obj *keyPtr = NULL;
+ int done = 0;
/*
* At this point, we know we have a dictionary (or at least something
@@ -1908,10 +1927,10 @@ DictValuesCmd(
int objc,
Tcl_Obj *const *objv)
{
- Tcl_Obj *valuePtr, *listPtr;
+ Tcl_Obj *valuePtr = NULL, *listPtr;
Tcl_DictSearch search;
int done;
- char *pattern;
+ const char *pattern;
if (objc!=2 && objc!=3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
@@ -2073,11 +2092,7 @@ DictInfoCmd(
}
dict = dictPtr->internalRep.otherValuePtr;
- /*
- * This next cast is actually OK.
- */
-
- Tcl_SetResult(interp, (char *) Tcl_HashStats(&dict->table), TCL_DYNAMIC);
+ Tcl_SetResult(interp, Tcl_HashStats(&dict->table), TCL_DYNAMIC);
return TCL_OK;
}
@@ -2364,7 +2379,7 @@ DictAppendCmd(
/*
*----------------------------------------------------------------------
*
- * DictForCmd --
+ * DictForNRCmd --
*
* This function implements the "dict for" Tcl command. See the user
* documentation for details on what it does, and TIP#111 for the formal
@@ -2380,7 +2395,7 @@ DictAppendCmd(
*/
static int
-DictForCmd(
+DictForNRCmd(
ClientData dummy,
Tcl_Interp *interp,
int objc,
@@ -2389,8 +2404,8 @@ DictForCmd(
Interp *iPtr = (Interp *) interp;
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
Tcl_Obj **varv, *keyObj, *valueObj;
- Tcl_DictSearch search;
- int varc, done, result;
+ Tcl_DictSearch *searchPtr;
+ int varc, done;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2398,6 +2413,10 @@ DictForCmd(
return TCL_ERROR;
}
+ /*
+ * Parse arguments.
+ */
+
if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2406,14 +2425,20 @@ DictForCmd(
TCL_STATIC);
return TCL_ERROR;
}
- keyVarObj = varv[0];
- valueVarObj = varv[1];
- scriptObj = objv[3];
-
- if (Tcl_DictObjFirst(interp, objv[2], &search, &keyObj, &valueObj,
+ searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
+ if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
&done) != TCL_OK) {
+ TclStackFree(interp, searchPtr);
return TCL_ERROR;
}
+ if (done) {
+ TclStackFree(interp, searchPtr);
+ return TCL_OK;
+ }
+ TclListObjGetElements(NULL, objv[1], &varc, &varv);
+ keyVarObj = varv[0];
+ valueVarObj = varv[1];
+ scriptObj = objv[3];
/*
* Make sure that these objects (which we need throughout the body of the
@@ -2425,64 +2450,131 @@ DictForCmd(
Tcl_IncrRefCount(valueVarObj);
Tcl_IncrRefCount(scriptObj);
- result = TCL_OK;
- while (!done) {
- /*
- * Stop the value from getting hit in any way by any traces on the key
- * variable.
- */
+ /*
+ * 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, 0) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set key variable: \"",
- TclGetString(keyVarObj), "\"", NULL);
- TclDecrRefCount(valueObj);
- result = TCL_ERROR;
- break;
- }
+ Tcl_IncrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't set key variable: \"",
+ TclGetString(keyVarObj), "\"", NULL);
TclDecrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set value variable: \"",
- TclGetString(valueVarObj), "\"", NULL);
- result = TCL_ERROR;
- break;
- }
+ goto error;
+ }
+ TclDecrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't set value variable: \"",
+ TclGetString(valueVarObj), "\"", NULL);
+ goto error;
+ }
- /*
- * TIP #280. Make invoking context available to loop body.
- */
+ /*
+ * Run the script.
+ */
- result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
- if (result == TCL_CONTINUE) {
+ TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
+ valueVarObj, scriptObj);
+ return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+
+ /*
+ * For unwinding everything on error.
+ */
+
+ error:
+ TclDecrRefCount(keyVarObj);
+ TclDecrRefCount(valueVarObj);
+ TclDecrRefCount(scriptObj);
+ Tcl_DictObjDone(searchPtr);
+ TclStackFree(interp, searchPtr);
+ return TCL_ERROR;
+}
+
+static int
+DictForLoopCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_DictSearch *searchPtr = data[0];
+ Tcl_Obj *keyVarObj = data[1];
+ Tcl_Obj *valueVarObj = data[2];
+ Tcl_Obj *scriptObj = data[3];
+ Tcl_Obj *keyObj, *valueObj;
+ int done;
+
+ /*
+ * Process the result from the previous execution of the script body.
+ */
+
+ if (result == TCL_CONTINUE) {
+ result = TCL_OK;
+ } else if (result != TCL_OK) {
+ if (result == TCL_BREAK) {
+ Tcl_ResetResult(interp);
result = TCL_OK;
- } else if (result != TCL_OK) {
- if (result == TCL_BREAK) {
- result = TCL_OK;
- } else if (result == TCL_ERROR) {
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"dict for\" body line %d)",
- interp->errorLine));
- }
- break;
+ } else if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"dict for\" body line %d)",
+ Tcl_GetErrorLine(interp)));
}
+ goto done;
+ }
+
+ /*
+ * Get the next mapping from the dictionary.
+ */
+
+ Tcl_DictObjNext(searchPtr, &keyObj, &valueObj, &done);
+ if (done) {
+ Tcl_ResetResult(interp);
+ goto done;
+ }
+
+ /*
+ * Stop the value from getting hit in any way by any traces on the key
+ * variable.
+ */
- Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+ Tcl_IncrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't set key variable: \"",
+ TclGetString(keyVarObj), "\"", NULL);
+ TclDecrRefCount(valueObj);
+ result = TCL_ERROR;
+ goto done;
+ }
+ TclDecrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't set value variable: \"",
+ TclGetString(valueVarObj), "\"", NULL);
+ result = TCL_ERROR;
+ goto done;
}
/*
- * Stop holding a reference to these objects.
+ * Run the script.
*/
+ TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
+ valueVarObj, scriptObj);
+ return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+
+ /*
+ * For unwinding everything once the iterating is done.
+ */
+
+ done:
TclDecrRefCount(keyVarObj);
TclDecrRefCount(valueVarObj);
TclDecrRefCount(scriptObj);
-
- Tcl_DictObjDone(&search);
- if (result == TCL_OK) {
- Tcl_ResetResult(interp);
- }
+ Tcl_DictObjDone(searchPtr);
+ TclStackFree(interp, searchPtr);
return result;
}
@@ -2631,20 +2723,20 @@ DictFilterCmd(
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
- static const char *filters[] = {
+ static const char *const filters[] = {
"key", "script", "value", NULL
};
enum FilterTypes {
FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
};
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
- Tcl_Obj **varv, *keyObj, *valueObj, *resultObj, *boolObj;
+ Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj;
Tcl_DictSearch search;
int index, varc, done, result, satisfied;
- char *pattern;
+ const char *pattern;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ...");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
@@ -2654,11 +2746,6 @@ DictFilterCmd(
switch ((enum FilterTypes) index) {
case FILTER_KEYS:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "dictionary key globPattern");
- return TCL_ERROR;
- }
-
/*
* Create a dictionary whose keys all match a certain pattern.
*/
@@ -2667,23 +2754,52 @@ DictFilterCmd(
&keyObj, &valueObj, &done) != TCL_OK) {
return TCL_ERROR;
}
- pattern = TclGetString(objv[3]);
- resultObj = Tcl_NewDictObj();
- if (TclMatchIsTrivial(pattern)) {
+ if (objc == 3) {
/*
- * Must release the search lock here to prevent a memory leak
- * since we are not exhausing the search. [Bug 1705778, leak K05]
+ * Nothing to match, so return nothing (== empty dictionary).
*/
Tcl_DictObjDone(&search);
- Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
- if (valueObj != NULL) {
- Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
+ return TCL_OK;
+ } else if (objc == 4) {
+ pattern = TclGetString(objv[3]);
+ resultObj = Tcl_NewDictObj();
+ if (TclMatchIsTrivial(pattern)) {
+ /*
+ * Must release the search lock here to prevent a memory leak
+ * since we are not exhausing the search. [Bug 1705778, leak
+ * K05]
+ */
+
+ Tcl_DictObjDone(&search);
+ Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
+ if (valueObj != NULL) {
+ Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
+ }
+ } else {
+ while (!done) {
+ if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
+ Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ }
+ Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+ }
}
} else {
+ /*
+ * Can't optimize this match for trivial globbing: would disturb
+ * order.
+ */
+
+ resultObj = Tcl_NewDictObj();
while (!done) {
- if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ int i;
+
+ for (i=3 ; i<objc ; i++) {
+ pattern = TclGetString(objv[i]);
+ if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
+ Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ break; /* stop inner loop */
+ }
}
Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
@@ -2692,11 +2808,6 @@ DictFilterCmd(
return TCL_OK;
case FILTER_VALUES:
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "dictionary value globPattern");
- return TCL_ERROR;
- }
-
/*
* Create a dictionary whose values all match a certain pattern.
*/
@@ -2705,11 +2816,16 @@ DictFilterCmd(
&keyObj, &valueObj, &done) != TCL_OK) {
return TCL_ERROR;
}
- pattern = TclGetString(objv[3]);
resultObj = Tcl_NewDictObj();
while (!done) {
- if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ int i;
+
+ for (i=3 ; i<objc ; i++) {
+ pattern = TclGetString(objv[i]);
+ if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
+ Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+ break; /* stop inner loop */
+ }
}
Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
@@ -2823,7 +2939,7 @@ DictFilterCmd(
case TCL_ERROR:
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"dict filter\" script line %d)",
- interp->errorLine));
+ Tcl_GetErrorLine(interp)));
default:
goto abnormalResult;
}
@@ -2892,8 +3008,7 @@ DictUpdateCmd(
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *objPtr;
- int i, result, dummy;
- Tcl_InterpState state;
+ int i, dummy;
if (objc < 5 || !(objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2926,10 +3041,34 @@ DictUpdateCmd(
TclDecrRefCount(dictPtr);
/*
- * Execute the body.
+ * Execute the body after setting up the NRE handler to process the
+ * results.
+ */
+
+ objPtr = Tcl_NewListObj(objc-3, objv+2);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_IncrRefCount(objv[1]);
+ TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
+
+ return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+}
+
+static int
+FinalizeDictUpdate(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj *dictPtr, *objPtr, **objv;
+ Tcl_InterpState state;
+ int i, objc;
+ Tcl_Obj *varName = data[0];
+ Tcl_Obj *argsObj = data[1];
+
+ /*
+ * ErrorInfo handling.
*/
- result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (body of \"dict update\")");
}
@@ -2938,8 +3077,10 @@ DictUpdateCmd(
* If the dictionary variable doesn't exist, drop everything silently.
*/
- dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+ dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0);
if (dictPtr == NULL) {
+ TclDecrRefCount(varName);
+ TclDecrRefCount(argsObj);
return result;
}
@@ -2948,8 +3089,10 @@ DictUpdateCmd(
*/
state = Tcl_SaveInterpState(interp, result);
- if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) {
+ if (Tcl_DictObjSize(interp, dictPtr, &objc) != TCL_OK) {
Tcl_DiscardInterpState(state);
+ TclDecrRefCount(varName);
+ TclDecrRefCount(argsObj);
return TCL_ERROR;
}
@@ -2962,7 +3105,8 @@ DictUpdateCmd(
* an instruction to remove the key.
*/
- for (i=2 ; i+2<objc ; i+=2) {
+ Tcl_ListObjGetElements(NULL, argsObj, &objc, &objv);
+ for (i=0 ; i<objc ; i+=2) {
objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
if (objPtr == NULL) {
Tcl_DictObjRemove(interp, dictPtr, objv[i]);
@@ -2979,17 +3123,20 @@ DictUpdateCmd(
Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
}
}
+ TclDecrRefCount(argsObj);
/*
* Write the dictionary back to its variable.
*/
- if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+ if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DiscardInterpState(state);
+ TclDecrRefCount(varName);
return TCL_ERROR;
}
+ TclDecrRefCount(varName);
return Tcl_RestoreInterpState(interp, state);
}
@@ -3019,10 +3166,9 @@ DictWithCmd(
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
+ Tcl_Obj *dictPtr, *keysPtr, *keyPtr = NULL, *valPtr = NULL, *pathPtr;
Tcl_DictSearch s;
- Tcl_InterpState state;
- int done, result, keyc, i, allocdict = 0;
+ int done;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
@@ -3072,10 +3218,34 @@ DictWithCmd(
/*
* Execute the body, while making the invoking context available to the
- * loop body (TIP#280).
+ * loop body (TIP#280) and postponing the cleanup until later (NRE).
*/
- result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+ pathPtr = NULL;
+ if (objc > 3) {
+ pathPtr = Tcl_NewListObj(objc-3, objv+2);
+ Tcl_IncrRefCount(pathPtr);
+ }
+ Tcl_IncrRefCount(objv[1]);
+ TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
+ NULL);
+
+ return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+}
+
+static int
+FinalizeDictWith(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj **keyv, *leafPtr, *dictPtr, *valPtr;
+ int keyc, i, allocdict = 0;
+ Tcl_InterpState state;
+ Tcl_Obj *varName = data[0];
+ Tcl_Obj *keysPtr = data[1];
+ Tcl_Obj *pathPtr = data[2];
+
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")");
}
@@ -3084,9 +3254,13 @@ DictWithCmd(
* If the dictionary variable doesn't exist, drop everything silently.
*/
- dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+ dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0);
if (dictPtr == NULL) {
+ TclDecrRefCount(varName);
TclDecrRefCount(keysPtr);
+ if (pathPtr) {
+ TclDecrRefCount(pathPtr);
+ }
return result;
}
@@ -3096,7 +3270,11 @@ DictWithCmd(
state = Tcl_SaveInterpState(interp, result);
if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) {
+ TclDecrRefCount(varName);
TclDecrRefCount(keysPtr);
+ if (pathPtr) {
+ TclDecrRefCount(pathPtr);
+ }
Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
@@ -3106,7 +3284,10 @@ DictWithCmd(
allocdict = 1;
}
- if (objc > 3) {
+ if (pathPtr != NULL) {
+ Tcl_Obj **pathv;
+ int pathc;
+
/*
* Want to get to the dictionary which we will update; need to do
* prepare-for-update de-sharing along the path *but* avoid generating
@@ -3116,9 +3297,12 @@ DictWithCmd(
* perfectly efficient (but no memory should be leaked).
*/
- leafPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
+ Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
+ leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
DICT_PATH_EXISTS | DICT_PATH_UPDATE);
+ TclDecrRefCount(pathPtr);
if (leafPtr == NULL) {
+ TclDecrRefCount(varName);
TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
@@ -3127,6 +3311,7 @@ DictWithCmd(
return TCL_ERROR;
}
if (leafPtr == DICT_PATH_NON_EXISTENT) {
+ TclDecrRefCount(varName);
TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
@@ -3164,7 +3349,7 @@ DictWithCmd(
* rep.
*/
- if (objc > 3) {
+ if (pathPtr != NULL) {
InvalidateDictChain(leafPtr);
}
@@ -3172,11 +3357,12 @@ DictWithCmd(
* Write back the outermost dictionary to the variable.
*/
- if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+ if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
+ TclDecrRefCount(varName);
return Tcl_RestoreInterpState(interp, state);
}
@@ -3204,7 +3390,7 @@ TclInitDictCmd(
{
return TclMakeEnsemble(interp, "dict", implementationMap);
}
-
+
/*
* Local Variables:
* mode: c
generated by cgit v0.12 at 2024-08-20 12:19:59 (GMT)