summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclDictObj.c14
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclUtil.c105
-rw-r--r--tests/dict.test20
4 files changed, 104 insertions, 39 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index f3c582c..77f66fb 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -651,9 +651,9 @@ SetDictFromAny(
const char *elemStart;
int elemSize, literal;
- if (TclFindElement(interp, nextElem, (limit - nextElem),
+ if (TclFindDictElement(interp, nextElem, (limit - nextElem),
&elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
- goto errorInFindElement;
+ goto errorInFindDictElement;
}
if (elemStart == limit) {
break;
@@ -672,10 +672,10 @@ SetDictFromAny(
keyPtr->bytes);
}
- if (TclFindElement(interp, nextElem, (limit - nextElem),
+ if (TclFindDictElement(interp, nextElem, (limit - nextElem),
&elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
TclDecrRefCount(keyPtr);
- goto errorInFindElement;
+ goto errorInFindDictElement;
}
if (literal) {
@@ -720,12 +720,8 @@ SetDictFromAny(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing value to go with key", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
- } else {
- errorInFindElement:
- if (interp != NULL) {
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
- }
}
+ errorInFindDictElement:
DeleteChainTable(dict);
ckfree(dict);
return TCL_ERROR;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b1a368e..9a2e8dd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2881,6 +2881,10 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
MODULE_SCOPE int TclConvertElement(const char *src, int length,
char *dst, int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
+MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
+ const char *dict, int dictLength,
+ const char **elementPtr, const char **nextPtr,
+ int *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evulation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line,
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 2d00adf..ae3adae 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -111,7 +111,11 @@ static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int SetEndOffsetFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static void UpdateStringOfEndOffset(Tcl_Obj *objPtr);
-
+static int FindElement(Tcl_Interp *interp, const char *string,
+ int stringLength, const char *typeStr,
+ const char *typeCode, const char **elementPtr,
+ const char **nextPtr, int *sizePtr,
+ int *literalPtr);
/*
* The following is the Tcl object type definition for an object that
* represents a list index in the form, "end-offset". It is used as a
@@ -237,7 +241,7 @@ const Tcl_ObjType tclEndOffsetType = {
* of either braces or quotes to delimit it.
*
* This collection of parsing rules is implemented in the routine
- * TclFindElement().
+ * FindElement().
*
* In order to produce lists that can be parsed by these rules, we need the
* ability to distinguish between characters that are part of a list element
@@ -505,9 +509,70 @@ TclFindElement(
* does not/does require a call to
* TclCopyAndCollapse() by the caller. */
{
- const char *p = list;
+ return FindElement(interp, list, listLength, "list", "LIST", elementPtr,
+ nextPtr, sizePtr, literalPtr);
+}
+
+int
+TclFindDictElement(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. If
+ * NULL, then no error message is left after
+ * errors. */
+ const char *dict, /* Points to the first byte of a string
+ * containing a Tcl dictionary with zero or
+ * more keys and values (possibly in
+ * braces). */
+ int dictLength, /* Number of bytes in the dict's string. */
+ const char **elementPtr, /* Where to put address of first significant
+ * character in the first element (i.e., key
+ * or value) of dict. */
+ const char **nextPtr, /* Fill in with location of character just
+ * after all white space following end of
+ * element (next arg or end of list). */
+ int *sizePtr, /* If non-zero, fill in with size of
+ * element. */
+ int *literalPtr) /* If non-zero, fill in with non-zero/zero to
+ * indicate that the substring of *sizePtr
+ * bytes starting at **elementPtr is/is not
+ * the literal key or value and therefore
+ * does not/does require a call to
+ * TclCopyAndCollapse() by the caller. */
+{
+ return FindElement(interp, dict, dictLength, "dict", "DICTIONARY",
+ elementPtr, nextPtr, sizePtr, literalPtr);
+}
+
+static int
+FindElement(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. If
+ * NULL, then no error message is left after
+ * errors. */
+ const char *string, /* Points to the first byte of a string
+ * containing a Tcl list or dictionary with
+ * zero or more elements (possibly in
+ * braces). */
+ int stringLength, /* Number of bytes in the string. */
+ const char *typeStr, /* The name of the type of thing we are
+ * parsing, for error messages. */
+ const char *typeCode, /* The type code for thing we are parsing, for
+ * error messages. */
+ const char **elementPtr, /* Where to put address of first significant
+ * character in first element. */
+ const char **nextPtr, /* Fill in with location of character just
+ * after all white space following end of
+ * argument (next arg or end of list/dict). */
+ int *sizePtr, /* If non-zero, fill in with size of
+ * element. */
+ int *literalPtr) /* If non-zero, fill in with non-zero/zero to
+ * indicate that the substring of *sizePtr
+ * bytes starting at **elementPtr is/is not
+ * the literal list/dict element and therefore
+ * does not/does require a call to
+ * TclCopyAndCollapse() by the caller. */
+{
+ const char *p = string;
const char *elemStart; /* Points to first byte of first element. */
- const char *limit; /* Points just after list's last byte. */
+ const char *limit; /* Points just after list/dict's last byte. */
int openBraces = 0; /* Brace nesting level during parse. */
int inQuotes = 0;
int size = 0; /* lint. */
@@ -517,11 +582,11 @@ TclFindElement(
/*
* Skim off leading white space and check for an opening brace or quote.
- * We treat embedded NULLs in the list as bytes belonging to a list
- * element.
+ * We treat embedded NULLs in the list/dict as bytes belonging to a list
+ * element (or dictionary key or value).
*/
- limit = (list + listLength);
+ limit = (string + stringLength);
while ((p < limit) && (TclIsSpaceProc(*p))) {
p++;
}
@@ -582,9 +647,9 @@ TclFindElement(
p2++;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "list element in braces followed by \"%.*s\" "
- "instead of space", (int) (p2-p), p));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
+ "%s element in braces followed by \"%.*s\" "
+ "instead of space", typeStr, (int) (p2-p), p));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
NULL);
}
return TCL_ERROR;
@@ -651,9 +716,9 @@ TclFindElement(
p2++;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "list element in quotes followed by \"%.*s\" "
- "instead of space", (int) (p2-p), p));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
+ "%s element in quotes followed by \"%.*s\" "
+ "instead of space", typeStr, (int) (p2-p), p));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
NULL);
}
return TCL_ERROR;
@@ -664,23 +729,23 @@ TclFindElement(
}
/*
- * End of list: terminate element.
+ * End of list/dict: terminate element.
*/
if (p == limit) {
if (openBraces != 0) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unmatched open brace in list", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "BRACE",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unmatched open brace in %s", typeStr));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "BRACE",
NULL);
}
return TCL_ERROR;
} else if (inQuotes) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unmatched open quote in list", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "QUOTE",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unmatched open quote in %s", typeStr));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "QUOTE",
NULL);
}
return TCL_ERROR;
diff --git a/tests/dict.test b/tests/dict.test
index ae6f42a..1439af9 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -182,32 +182,32 @@ test dict-4.13a {dict replace command: type check is mandatory} {
} {TCL VALUE DICTIONARY}
test dict-4.14 {dict replace command: type check is mandatory} -body {
dict replace { a b {}c d }
-} -returnCodes error -result {list element in braces followed by "c" instead of space}
+} -returnCodes error -result {dict element in braces followed by "c" instead of space}
test dict-4.14a {dict replace command: type check is mandatory} {
catch {dict replace { a b {}c d }} -> opt
dict get $opt -errorcode
-} {TCL VALUE DICTIONARY}
+} {TCL VALUE DICTIONARY JUNK}
test dict-4.15 {dict replace command: type check is mandatory} -body {
dict replace { a b ""c d }
-} -returnCodes error -result {list element in quotes followed by "c" instead of space}
+} -returnCodes error -result {dict element in quotes followed by "c" instead of space}
test dict-4.15a {dict replace command: type check is mandatory} {
catch {dict replace { a b ""c d }} -> opt
dict get $opt -errorcode
-} {TCL VALUE DICTIONARY}
+} {TCL VALUE DICTIONARY JUNK}
test dict-4.16 {dict replace command: type check is mandatory} -body {
dict replace " a b \"c d "
-} -returnCodes error -result {unmatched open quote in list}
+} -returnCodes error -result {unmatched open quote in dict}
test dict-4.16a {dict replace command: type check is mandatory} {
catch {dict replace " a b \"c d "} -> opt
dict get $opt -errorcode
-} {TCL VALUE DICTIONARY}
+} {TCL VALUE DICTIONARY QUOTE}
test dict-4.17 {dict replace command: type check is mandatory} -body {
dict replace " a b \{c d "
-} -returnCodes error -result {unmatched open brace in list}
+} -returnCodes error -result {unmatched open brace in dict}
test dict-4.17a {dict replace command: type check is mandatory} {
catch {dict replace " a b \{c d "} -> opt
dict get $opt -errorcode
-} {TCL VALUE DICTIONARY}
+} {TCL VALUE DICTIONARY BRACE}
test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d}
test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}
@@ -234,7 +234,7 @@ test dict-5.11 {dict remove command: type check is mandatory} -body {
} -returnCodes error -result {missing value to go with key}
test dict-5.12 {dict remove command: type check is mandatory} -body {
dict remove { a b {}c d }
-} -returnCodes error -result {list element in braces followed by "c" instead of space}
+} -returnCodes error -result {dict element in braces followed by "c" instead of space}
test dict-6.1 {dict keys command} {dict keys {a b}} a
test dict-6.2 {dict keys command} {dict keys {c d}} c
@@ -1296,7 +1296,7 @@ test dict-20.24 {dict merge command: type check is mandatory} -body {
} -returnCodes error -result {missing value to go with key}
test dict-20.25 {dict merge command: type check is mandatory} -body {
dict merge { a b {}c d }
-} -returnCodes error -result {list element in braces followed by "c" instead of space}
+} -returnCodes error -result {dict element in braces followed by "c" instead of space}
test dict-21.1 {dict update command} -returnCodes 1 -body {
dict update