Allow [dict exists {a {b c}} d e] to not be an error. [Bug 871387]

3 files changed, 52 insertions, 22 deletions

diff --git a/ChangeLog b/ChangeLog
index 7c7f167..56c9e47 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
 2004-01-14  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	* generic/tclDictObj.c (TraceDictPath, DictExistsCmd): Adjusted
+	behaviour of [dict exists] so a failure to look up a dictionary
+	along the path of dicts doesn't trigger an error.  This is how it
+	was documented to behave previously...  [Bug 871387]
+
 	* generic/tclDictObj.c: Assorted dict fixes from Peter Spjuth
 	relating to [Bug 876170].
 	(SetDictFromAny): Make sure that lists retain their ordering even
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 5d9fb9a..8755d4e 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,12 +9,30 @@
  * 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.13 2004/01/14 09:34:33 dkf Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.14 2004/01/14 22:07:43 dkf Exp $
  */
 
 #include "tclInt.h"
 
 /*
+ * Flag values for TraceDictPath().
+ *
+ * DICT_PATH_UPDATE indicates that we are going to be doing an update
+ * at the tip of the path, so duplication of shared objects should be
+ * done along the way.
+ *
+ * DICT_PATH_EXISTS indicates that we are performing an existance test
+ * and a lookup failure should therefore not be an error.  If (and
+ * only if) this flag is set, TraceDictPath() will return the special
+ * value DICT_PATH_NON_EXISTENT if the path is not traceable.
+ */
+
+#define DICT_PATH_UPDATE 1
+#define DICT_PATH_EXISTS 2
+
+#define DICT_PATH_NON_EXISTENT ((Tcl_Obj *) (void *) 1)
+
+/*
  * Prototypes for procedures defined later in this file:
  */
 
@@ -58,7 +76,7 @@ static int		SetDictFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 static void		UpdateStringOfDict _ANSI_ARGS_((Tcl_Obj *dictPtr));
 static Tcl_Obj *	TraceDictPath _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *rootPtr, int keyc, Tcl_Obj *CONST keyv[],
-			    int willUpdate));
+			    int flags));
 struct Dict;
 static void		DeleteDict _ANSI_ARGS_((struct Dict *dict));
 
@@ -545,25 +563,27 @@ SetDictFromAny(interp, objPtr)
  * Results:
  *	The object at the end of the path, or NULL if there was an error.
  *	Note that this it is an error for an intermediate dictionary on
- *	the path to not exist.
+ *	the path to not exist.  If the flags argument is DICT_PATH_EXISTS,
+ *	a non-existent path gives a DICT_PATH_NON_EXISTENT result.
  *
  * Side effects:
- *	If the willUpdate flag is false, there are no side effects (other
- *	than potential conversion of objects to dictionaries.)  If the
- *	willUpdate flag is true, the following additional side effects
- *	occur.  Shared dictionaries along the path are converted into
- *	unshared objects, and a backward-pointing chain is built using
- *	the chain fields of the dictionaries (for easy invalidation of
- *	string representations.)
+ *	If the flags argument is zero or DICT_PATH_EXISTS, there are
+ *	no side effects (other than potential conversion of objects to
+ *	dictionaries.)  If the flags argument is DICT_PATH_UPDATE, the
+ *	following additional side effects occur.  Shared dictionaries
+ *	along the path are converted into unshared objects, and a
+ *	backward-pointing chain is built using the chain fields of the
+ *	dictionaries (for easy invalidation of string
+ *	representations.)
  *
  *----------------------------------------------------------------------
  */
 
 static Tcl_Obj *
-TraceDictPath(interp, dictPtr, keyc, keyv, willUpdate)
+TraceDictPath(interp, dictPtr, keyc, keyv, flags)
     Tcl_Interp *interp;
     Tcl_Obj *dictPtr, *CONST keyv[];
-    int keyc, willUpdate;
+    int keyc, flags;
 {
     Dict *dict, *newDict;
     int i;
@@ -574,7 +594,7 @@ TraceDictPath(interp, dictPtr, keyc, keyv, willUpdate)
 	}
     }
     dict = (Dict *) dictPtr->internalRep.otherValuePtr;
-    if (willUpdate) {
+    if (flags == DICT_PATH_UPDATE) {
 	dict->chain = NULL;
     }
 
@@ -583,6 +603,9 @@ TraceDictPath(interp, dictPtr, keyc, keyv, willUpdate)
 	Tcl_Obj *tmpObj;
 
 	if (hPtr == NULL) {
+	    if (flags == DICT_PATH_EXISTS) {
+		return DICT_PATH_NON_EXISTENT;
+	    }
 	    if (interp != NULL) {
 		Tcl_ResetResult(interp);
 		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -599,7 +622,7 @@ TraceDictPath(interp, dictPtr, keyc, keyv, willUpdate)
 	    }
 	}
 	newDict = (Dict *) tmpObj->internalRep.otherValuePtr;
-	if (willUpdate) {
+	if (flags == DICT_PATH_UPDATE) {
 	    if (Tcl_IsShared(tmpObj)) {
 		Tcl_DecrRefCount(tmpObj);
 		tmpObj = Tcl_DuplicateObj(tmpObj);
@@ -1032,7 +1055,7 @@ Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr)
 	Tcl_Panic("Tcl_DictObjPutKeyList called with empty key list");
     }
 
-    dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, /*willUpdate*/ 1);
+    dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_UPDATE);
     if (dictPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1088,7 +1111,7 @@ Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv)
 	Tcl_Panic("Tcl_DictObjRemoveKeyList called with empty key list");
     }
 
-    dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, /*willUpdate*/ 1);
+    dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_UPDATE);
     if (dictPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1320,7 +1343,7 @@ DictGetCmd(interp, objc, objv)
      * going through a chain of searches.)  Note that this loop always
      * executes at least once.
      */
-    dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, /*willUpdate*/ 0);
+    dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, 0);
     if (dictPtr == NULL) {
 	return TCL_ERROR;
     }
@@ -1618,10 +1641,14 @@ DictExistsCmd(interp, objc, objv)
 	return TCL_ERROR;
     }
 
-    dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, /*willUpdate*/ 0);
+    dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, DICT_PATH_EXISTS);
     if (dictPtr == NULL) {
 	return TCL_ERROR;
     }
+    if (dictPtr == DICT_PATH_NON_EXISTENT) {
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+	return TCL_OK;
+    }
     result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);
     if (result != TCL_OK) {
 	return result;
diff --git a/tests/dict.test b/tests/dict.test
index c7ea06d..61c35b4 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -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: dict.test,v 1.5 2004/01/14 09:34:33 dkf Exp $
+# RCS: @(#) $Id: dict.test,v 1.6 2004/01/14 22:07:43 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -204,9 +204,7 @@ test dict-9.1 {dict exists command} {dict exists {a b} a} 1
 test dict-9.2 {dict exists command} {dict exists {a b} b} 0
 test dict-9.3 {dict exists command} {dict exists {a {b c}} a b} 1
 test dict-9.4 {dict exists command} {dict exists {a {b c}} a c} 0
-test dict-9.5 {dict exists command} {
-    list [catch {dict exists {a {b c}} b c} msg] $msg
-} {1 {key "b" not known in dictionary}}
+test dict-9.5 {dict exists command} {dict exists {a {b c}} b c} 0
 test dict-9.6 {dict exists command} {
     list [catch {dict exists {a {b c d}} a c} msg] $msg
 } {1 {missing value to go with key}}