summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclDictObj.c75
-rw-r--r--tests/dict.test71
2 files changed, 105 insertions, 41 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index e31d708..f3c582c 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -600,7 +600,7 @@ SetDictFromAny(
Tcl_Obj *objPtr)
{
Tcl_HashEntry *hPtr;
- int isNew, result;
+ int isNew;
Dict *dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
@@ -651,10 +651,9 @@ SetDictFromAny(
const char *elemStart;
int elemSize, literal;
- result = TclFindElement(interp, nextElem, (limit - nextElem),
- &elemStart, &nextElem, &elemSize, &literal);
- if (result != TCL_OK) {
- goto errorExit;
+ if (TclFindElement(interp, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
+ goto errorInFindElement;
}
if (elemStart == limit) {
break;
@@ -673,11 +672,10 @@ SetDictFromAny(
keyPtr->bytes);
}
- result = TclFindElement(interp, nextElem, (limit - nextElem),
- &elemStart, &nextElem, &elemSize, &literal);
- if (result != TCL_OK) {
+ if (TclFindElement(interp, nextElem, (limit - nextElem),
+ &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
TclDecrRefCount(keyPtr);
- goto errorExit;
+ goto errorInFindElement;
}
if (literal) {
@@ -722,16 +720,15 @@ SetDictFromAny(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing value to go with key", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
- }
- result = TCL_ERROR;
-
- errorExit:
- if (interp != NULL) {
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+ } else {
+ errorInFindElement:
+ if (interp != NULL) {
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+ }
}
DeleteChainTable(dict);
ckfree(dict);
- return result;
+ return TCL_ERROR;
}
/*
@@ -1026,11 +1023,11 @@ Tcl_DictObjRemove(
}
}
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
dict = dictPtr->internalRep.twoPtrValue.ptr1;
if (DeleteChainEntry(dict, keyPtr)) {
+ if (dictPtr->bytes != NULL) {
+ TclInvalidateStringRep(dictPtr);
+ }
dict->epoch++;
}
return TCL_OK;
@@ -1629,8 +1626,7 @@ DictReplaceCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
- int i, result;
- int allocatedDict = 0;
+ int i;
if ((objc < 2) || (objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
@@ -1638,18 +1634,17 @@ DictReplaceCmd(
}
dictPtr = objv[1];
- if (Tcl_IsShared(dictPtr)) {
- dictPtr = Tcl_DuplicateObj(dictPtr);
- allocatedDict = 1;
+ if (dictPtr->typePtr != &tclDictType) {
+ int result = SetDictFromAny(interp, dictPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
}
for (i=2 ; i<objc ; i+=2) {
- result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
- if (result != TCL_OK) {
- if (allocatedDict) {
- TclDecrRefCount(dictPtr);
- }
- return TCL_ERROR;
+ if (Tcl_IsShared(dictPtr)) {
+ dictPtr = Tcl_DuplicateObj(dictPtr);
}
+ (void) Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
}
Tcl_SetObjResult(interp, dictPtr);
return TCL_OK;
@@ -1681,8 +1676,7 @@ DictRemoveCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
- int i, result;
- int allocatedDict = 0;
+ int i;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
@@ -1690,18 +1684,17 @@ DictRemoveCmd(
}
dictPtr = objv[1];
- if (Tcl_IsShared(dictPtr)) {
- dictPtr = Tcl_DuplicateObj(dictPtr);
- allocatedDict = 1;
+ if (dictPtr->typePtr != &tclDictType) {
+ int result = SetDictFromAny(interp, dictPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
}
for (i=2 ; i<objc ; i++) {
- result = Tcl_DictObjRemove(interp, dictPtr, objv[i]);
- if (result != TCL_OK) {
- if (allocatedDict) {
- TclDecrRefCount(dictPtr);
- }
- return TCL_ERROR;
+ if (Tcl_IsShared(dictPtr)) {
+ dictPtr = Tcl_DuplicateObj(dictPtr);
}
+ (void) Tcl_DictObjRemove(interp, dictPtr, objv[i]);
}
Tcl_SetObjResult(interp, dictPtr);
return TCL_OK;
diff --git a/tests/dict.test b/tests/dict.test
index a583de8..ae6f42a 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -167,6 +167,47 @@ test dict-4.8 {dict replace command} -returnCodes error -body {
} -result {missing value to go with key}
test dict-4.9 {dict replace command} {dict replace [list a a] a b} {a b}
test dict-4.10 {dict replace command} {dict replace [list a a] a b a c} {a c}
+test dict-4.11 {dict replace command: canonicality not forced} {
+ dict replace { a b c d }
+} { a b c d }
+test dict-4.12 {dict replace command: canonicality forced by update} {
+ dict replace { a b c d } a b
+} {a b c d}
+test dict-4.13 {dict replace command: type check is mandatory} -body {
+ dict replace { a b c d e }
+} -returnCodes error -result {missing value to go with key}
+test dict-4.13a {dict replace command: type check is mandatory} {
+ catch {dict replace { a b c d e }} -> opt
+ dict get $opt -errorcode
+} {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}
+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}
+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}
+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}
+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}
+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}
+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}
+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}
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}
@@ -179,6 +220,21 @@ test dict-5.6 {dict remove command} {dict remove {a b} c} {a b}
test dict-5.7 {dict remove command} -returnCodes error -body {
dict remove
} -result {wrong # args: should be "dict remove dictionary ?key ...?"}
+test dict-5.8 {dict remove command: canonicality not forced} {
+ dict remove { a b c d }
+} { a b c d }
+test dict-5.9 {dict remove command: canonicality not forced} {
+ dict remove { a b c d } e
+} { a b c d }
+test dict-5.10 {dict remove command: canonicality forced by update} {
+ dict remove { a b c d } c
+} {a b}
+test dict-5.11 {dict remove command: type check is mandatory} -body {
+ dict remove { a b c d e }
+} -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}
test dict-6.1 {dict keys command} {dict keys {a b}} a
test dict-6.2 {dict keys command} {dict keys {c d}} c
@@ -1226,6 +1282,21 @@ test dict-20.19 {dict merge command} {
test dict-20.20 {dict merge command} {
apply {{} {dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}}}
} {a - c d e f 1 - 3 4}
+test dict-20.21 {dict merge command: canonicality not forced} {
+ dict merge { a b c d }
+} { a b c d }
+test dict-20.22 {dict merge command: canonicality not forced} {
+ dict merge { a b c d } {}
+} { a b c d }
+test dict-20.23 {dict merge command: canonicality forced by update} {
+ dict merge { a b c d } {a b}
+} {a b c d}
+test dict-20.24 {dict merge command: type check is mandatory} -body {
+ dict merge { a b c d e }
+} -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}
test dict-21.1 {dict update command} -returnCodes 1 -body {
dict update
generated by cgit v0.12 at 2024-09-12 06:03:58 (GMT)