Attachment "dict.patch" to
ticket [871387ffff]
added by
dkf
2004-01-15 05:10:43.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.1811
diff -u -r1.1811 ChangeLog
--- ChangeLog 14 Jan 2004 09:34:32 -0000 1.1811
+++ ChangeLog 14 Jan 2004 21:55:32 -0000
@@ -1,5 +1,10 @@
2004-01-14 Donal K. Fellows <[email protected]>
+ * 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
Index: generic/tclBinary.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBinary.c,v
retrieving revision 1.16
diff -u -r1.16 tclBinary.c
--- generic/tclBinary.c 24 Dec 2003 04:18:18 -0000 1.16
+++ generic/tclBinary.c 14 Jan 2004 21:55:37 -0000
@@ -1040,7 +1040,10 @@
cursor = buffer;
arg = 4;
offset = 0;
- while (*format != '\0') {
+ while (1) {
+ if (*format != '\0') {
+ goto done;
+ }
str = format;
if (!GetFormatSpec(&format, &cmd, &count)) {
goto done;
Index: generic/tclDictObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDictObj.c,v
retrieving revision 1.13
diff -u -r1.13 tclDictObj.c
--- generic/tclDictObj.c 14 Jan 2004 09:34:33 -0000 1.13
+++ generic/tclDictObj.c 14 Jan 2004 21:55:41 -0000
@@ -15,6 +15,24 @@
#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 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 @@
* 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 @@
}
}
dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- if (willUpdate) {
+ if (flags == DICT_PATH_UPDATE) {
dict->chain = NULL;
}
@@ -583,6 +603,9 @@
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 @@
}
}
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_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_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 @@
* 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 @@
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;
Index: tests/dict.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/dict.test,v
retrieving revision 1.5
diff -u -r1.5 dict.test
--- tests/dict.test 14 Jan 2004 09:34:33 -0000 1.5
+++ tests/dict.test 14 Jan 2004 21:55:44 -0000
@@ -204,9 +204,7 @@
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}}
