summaryrefslogtreecommitdiffstats
path: root/generic/tclDictObj.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2008-07-17 15:43:53 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2008-07-17 15:43:53 (GMT)
commit0603043c5b5bc7a0a930f38c71c5e4810f4831f4 (patch)
tree2968eb61e8e09c114a0445e988a9475f4464a87a /generic/tclDictObj.c
parent8c89eda3cecbbeefdac39bbaf98c2230a64bebd2 (diff)
downloadtcl-0603043c5b5bc7a0a930f38c71c5e4810f4831f4.zip
tcl-0603043c5b5bc7a0a930f38c71c5e4810f4831f4.tar.gz
tcl-0603043c5b5bc7a0a930f38c71c5e4810f4831f4.tar.bz2
Add NRE support to [dict with].
Diffstat (limited to 'generic/tclDictObj.c')
-rw-r--r--generic/tclDictObj.c61
1 files changed, 50 insertions, 11 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 5a617bc..570059e 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.58 2008/06/01 02:42:20 kennykb Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.59 2008/07/17 15:43:53 dkf Exp $
*/
#include "tclInt.h"
@@ -74,6 +74,8 @@ 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 FinalizeDictWith(ClientData data[],
+ Tcl_Interp *interp, int result);
/*
* Table of dict subcommand names and implementations.
@@ -3015,10 +3017,9 @@ DictWithCmd(
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
+ Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, *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");
@@ -3068,10 +3069,32 @@ 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(objv[1]);
+ TclNR_AddCallback(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\")");
}
@@ -3080,9 +3103,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;
}
@@ -3092,7 +3119,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;
}
@@ -3102,7 +3133,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
@@ -3112,9 +3146,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);
@@ -3123,6 +3160,7 @@ DictWithCmd(
return TCL_ERROR;
}
if (leafPtr == DICT_PATH_NON_EXISTENT) {
+ TclDecrRefCount(varName);
TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
@@ -3160,7 +3198,7 @@ DictWithCmd(
* rep.
*/
- if (objc > 3) {
+ if (pathPtr != NULL) {
InvalidateDictChain(leafPtr);
}
@@ -3168,11 +3206,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);
}