diff options
author | dkf <dkf@noemail.net> | 2008-07-17 20:43:35 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2008-07-17 20:43:35 (GMT) |
commit | 69c44f245ae99f8ebd611f9ab65aba1112eeef6a (patch) | |
tree | 88613ca85d55f034a29d7a5843b46647092f06de /generic/tclDictObj.c | |
parent | 281c650fbe0a897d7ed8d6f9559deca25602d27e (diff) | |
download | tcl-69c44f245ae99f8ebd611f9ab65aba1112eeef6a.zip tcl-69c44f245ae99f8ebd611f9ab65aba1112eeef6a.tar.gz tcl-69c44f245ae99f8ebd611f9ab65aba1112eeef6a.tar.bz2 |
NRE-ify the non-compiled version of [dict update].
FossilOrigin-Name: 90f8772b53b8946c0c536e48936c38faa85cf8f8
Diffstat (limited to 'generic/tclDictObj.c')
-rw-r--r-- | generic/tclDictObj.c | 49 |
1 files changed, 40 insertions, 9 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 570059e..a2cae3a 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.59 2008/07/17 15:43:53 dkf Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.60 2008/07/17 20:43:37 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 FinalizeDictUpdate(ClientData data[], + Tcl_Interp *interp, int result); static int FinalizeDictWith(ClientData data[], Tcl_Interp *interp, int result); @@ -2890,8 +2892,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, @@ -2924,10 +2925,32 @@ 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); + TclNR_AddCallback(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\")"); } @@ -2936,8 +2959,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; } @@ -2946,8 +2971,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; } @@ -2960,7 +2987,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]); @@ -2977,17 +3005,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); } |