summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2014-06-03 07:26:11 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2014-06-03 07:26:11 (GMT)
commitc519b689fd1cea30413a6f1d66639d46e0850606 (patch)
tree65804b56aefa887335c7ab2fdca90059642ad5e7
parent46ab1371a7cbd2e6d244d043a47d5123a716be33 (diff)
downloadtcl-c519b689fd1cea30413a6f1d66639d46e0850606.zip
tcl-c519b689fd1cea30413a6f1d66639d46e0850606.tar.gz
tcl-c519b689fd1cea30413a6f1d66639d46e0850606.tar.bz2
[1b0266d8bb] Working towards ensuring that all dict operations are sufficiently strict.
-rw-r--r--generic/tclDictObj.c46
-rw-r--r--tests/dict.test42
2 files changed, 63 insertions, 25 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index e31d708..71d5f5d 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -1026,11 +1026,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 +1629,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 +1637,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 +1679,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 +1687,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..1ccad7c 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -167,6 +167,18 @@ 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.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-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 +191,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 +1253,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