From f30d8e3cdfa9ffef067740f6c285a1dfb246c70d Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 17 Jul 2008 20:43:36 +0000
Subject: NRE-ify the non-compiled version of [dict update].

---
 ChangeLog            |  4 +++-
 generic/tclDictObj.c | 49 ++++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 43 insertions(+), 10 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 734e172..16317ad 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,9 +2,11 @@
 
 	* generic/tclDictObj.c (DictWithCmd, FinalizeDictWith): Split the
 	implementation of [dict with] so that it works with NRE.
+	(DictUpdateCmd, FinalizeDictUpdate): Similarly for the non-compiled
+	version of [dict update].
 
 2008-07-16  George Peter Staplin <georgeps@users.sf.net>
-	
+
 	* win/tclWinThrd.c: Test for TLS_OUT_OF_INDEXES to make certain that
 	thread key creation is successful.
 
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);
 }
 
-- 
cgit v0.12