summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-03-12 23:21:04 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-03-12 23:21:04 (GMT)
commit5c57bce0a0440c73bd76ec096ffa1c3d0f525b9f (patch)
treeb25e6c22ddc9fcd22aa3620d1debe028b7cd571e /generic
parent1969f4d63cdf7429ac325c01e8d15c4fcd94afc0 (diff)
downloadtcl-5c57bce0a0440c73bd76ec096ffa1c3d0f525b9f.zip
tcl-5c57bce0a0440c73bd76ec096ffa1c3d0f525b9f.tar.gz
tcl-5c57bce0a0440c73bd76ec096ffa1c3d0f525b9f.tar.bz2
Implementation of [dict merge] subcommand, based on [FRQ 745851]
Diffstat (limited to 'generic')
-rw-r--r--generic/tclDictObj.c96
1 files changed, 91 insertions, 5 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 8755d4e..bbbc156 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.14 2004/01/14 22:07:43 dkf Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.15 2004/03/12 23:21:05 dkf Exp $
*/
#include "tclInt.h"
@@ -56,6 +56,8 @@ static int DictKeysCmd _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST *objv));
static int DictLappendCmd _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST *objv));
+static int DictMergeCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST *objv));
static int DictRemoveCmd _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST *objv));
static int DictReplaceCmd _ANSI_ARGS_((Tcl_Interp *interp,
@@ -1467,6 +1469,89 @@ DictRemoveCmd(interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * DictMergeCmd --
+ *
+ * This function implements the "dict merge" Tcl command.
+ * See the user documentation for details on what it does, and
+ * TIP#163 for the formal specification.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictMergeCmd(interp, objc, objv)
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST *objv;
+{
+ Tcl_Obj *targetObj, *keyObj, *valueObj;
+ int allocatedDict = 0;
+ int i, done;
+ Tcl_DictSearch search;
+
+ if (objc == 2) {
+ /*
+ * No dictionary arguments; return default (empty value).
+ */
+ return TCL_OK;
+ }
+
+ if (objc == 3) {
+ /*
+ * Single argument, make sure it is a dictionary, but
+ * otherwise return it.
+ */
+ if (objv[2]->typePtr != &tclDictType) {
+ if (SetDictFromAny(interp, objv[2]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ Tcl_SetObjResult(interp, objv[2]);
+ return TCL_OK;
+ }
+
+ /*
+ * Normal behaviour: combining two (or more) dictionaries.
+ */
+
+ targetObj = objv[2];
+ if (Tcl_IsShared(targetObj)) {
+ targetObj = Tcl_DuplicateObj(targetObj);
+ allocatedDict = 1;
+ }
+ for (i=3 ; i<objc ; i++) {
+ if (Tcl_DictObjFirst(interp, objv[i], &search, &keyObj, &valueObj,
+ &done) != TCL_OK) {
+ if (allocatedDict) {
+ Tcl_DecrRefCount(targetObj);
+ }
+ return TCL_ERROR;
+ }
+ while (!done) {
+ if (Tcl_DictObjPut(interp, targetObj,
+ keyObj, valueObj) != TCL_OK) {
+ Tcl_DictObjDone(&search);
+ if (allocatedDict) {
+ Tcl_DecrRefCount(targetObj);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
+ }
+ }
+ Tcl_SetObjResult(interp, targetObj);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* DictKeysCmd --
*
* This function implements the "dict keys" Tcl command.
@@ -2595,13 +2680,13 @@ Tcl_DictObjCmd(/*ignored*/ clientData, interp, objc, objv)
{
static CONST char *subcommands[] = {
"append", "create", "exists", "filter", "for",
- "get", "incr", "info", "keys", "lappend", "remove",
- "replace", "set", "size", "unset", "values", NULL
+ "get", "incr", "info", "keys", "lappend", "merge",
+ "remove", "replace", "set", "size", "unset", "values", NULL
};
enum DictSubcommands {
DICT_APPEND, DICT_CREATE, DICT_EXISTS, DICT_FILTER, DICT_FOR,
- DICT_GET, DICT_INCR, DICT_INFO, DICT_KEYS, DICT_LAPPEND, DICT_REMOVE,
- DICT_REPLACE, DICT_SET, DICT_SIZE, DICT_UNSET, DICT_VALUES
+ DICT_GET, DICT_INCR, DICT_INFO, DICT_KEYS, DICT_LAPPEND, DICT_MERGE,
+ DICT_REMOVE, DICT_REPLACE, DICT_SET, DICT_SIZE, DICT_UNSET, DICT_VALUES
};
int index;
@@ -2624,6 +2709,7 @@ Tcl_DictObjCmd(/*ignored*/ clientData, interp, objc, objv)
case DICT_INFO: return DictInfoCmd(interp, objc, objv);
case DICT_KEYS: return DictKeysCmd(interp, objc, objv);
case DICT_LAPPEND: return DictLappendCmd(interp, objc, objv);
+ case DICT_MERGE: return DictMergeCmd(interp, objc, objv);
case DICT_REMOVE: return DictRemoveCmd(interp, objc, objv);
case DICT_REPLACE: return DictReplaceCmd(interp, objc, objv);
case DICT_SET: return DictSetCmd(interp, objc, objv);