diff options
Diffstat (limited to 'generic/tclDictObj.c')
| -rw-r--r-- | generic/tclDictObj.c | 61 |
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); } |