summaryrefslogtreecommitdiffstats
path: root/tests/dict.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/dict.test')
-rw-r--r--tests/dict.test2045
1 files changed, 1407 insertions, 638 deletions
diff --git a/tests/dict.test b/tests/dict.test
index 7b584e8..d5406d0 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -1,13 +1,13 @@
-# This test file covers the dictionary object type and the dict
-# command used to work with values of that type.
+# This test file covers the dictionary object type and the dict command used
+# to work with values of that type.
#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
-# Copyright (c) 2003 Donal K. Fellows
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 2003-2009 Donal K. Fellows
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -27,27 +27,13 @@ if {[testConstraint memory]} {
expr {$end - $tmp}
}
}
-
-# Procedure to help check the contents of a dictionary. Note that we
-# can't just compare the string version because the order of the
-# elements is (deliberately) not defined. This is because it is
-# dependent on the underlying hash table implementation and also
-# potentially on the history of the value itself. Net result: you
-# cannot safely assume anything about the ordering of values.
-proc getOrder {dictVal args} {
- foreach key $args {
- lappend result $key [dict get $dictVal $key]
- }
- lappend result [dict size $dictVal]
- return $result
-}
-
-test dict-1.1 {dict command basic syntax} {
- list [catch {dict} msg] $msg
-} {1 {wrong # args: should be "dict subcommand ?argument ...?"}}
-test dict-1.2 {dict command basic syntax} {
- list [catch {dict ?} msg] $msg
-} {1 {unknown or ambiguous subcommand "?": must be append, create, exists, filter, for, get, incr, info, keys, lappend, merge, remove, replace, set, size, unset, update, values, or with}}
+
+test dict-1.1 {dict command basic syntax} -returnCodes error -body {
+ dict
+} -result {wrong # args: should be "dict subcommand ?arg ...?"}
+test dict-1.2 {dict command basic syntax} -returnCodes error -body {
+ dict ?
+} -match glob -result {unknown or ambiguous subcommand "?": must be *}
test dict-2.1 {dict create command} {
dict create
@@ -55,7 +41,7 @@ test dict-2.1 {dict create command} {
test dict-2.2 {dict create command} {
dict create a b
} {a b}
-test dict-2.3 {dict create command} {
+test dict-2.3 {dict create command} -body {
set result {}
set dict [dict create a b c d]
# Can't compare directly as ordering of values is undefined
@@ -66,62 +52,86 @@ test dict-2.3 {dict create command} {
}
lappend result [lindex $dict [expr {$idx+1}]]
}
- set result
-} {b d}
-test dict-2.4 {dict create command} {
- list [catch {dict create a} msg] $msg
-} {1 {wrong # args: should be "dict create ?key value ...?"}}
-test dict-2.5 {dict create command} {
- list [catch {dict create a b c} msg] $msg
-} {1 {wrong # args: should be "dict create ?key value ...?"}}
-test dict-2.6 {dict create command - initialse refcount field!} {
+ return $result
+} -cleanup {
+ unset result dict key idx
+} -result {b d}
+test dict-2.4 {dict create command} -returnCodes error -body {
+ dict create a
+} -result {wrong # args: should be "dict create ?key value ...?"}
+test dict-2.5 {dict create command} -returnCodes error -body {
+ dict create a b c
+} -result {wrong # args: should be "dict create ?key value ...?"}
+test dict-2.6 {dict create command - initialse refcount field!} -body {
# Bug 715751 will show up in memory debuggers like purify
for {set i 0} {$i<10} {incr i} {
set dictv [dict create a 0]
set share [dict values $dictv]
list [dict incr dictv a]
}
-} {}
+} -cleanup {
+ unset i dictv share
+} -result {}
test dict-2.7 {dict create command - #-quoting in string rep} {
dict create # #comment
} {{#} #comment}
test dict-2.8 {dict create command - #-quoting in string rep} -body {
dict create #a x #b x
} -match glob -result {{#?} x #? x}
+test dict-2.9 {dict create command: compilation} {
+ apply {{} {dict create [format a] b}}
+} {a b}
+test dict-2.10 {dict create command: compilation} {
+ apply {{} {dict create [format a] b c d}}
+} {a b c d}
+test dict-2.11 {dict create command: compilation} {
+ apply {{} {dict create [format a] b c d a x}}
+} {a x c d}
+test dict-2.12 {dict create command: non-compilation} {
+ dict create [format a] b
+} {a b}
+test dict-2.13 {dict create command: non-compilation} {
+ dict create [format a] b c d
+} {a b c d}
+test dict-2.14 {dict create command: non-compilation} {
+ dict create [format a] b c d a x
+} {a x c d}
test dict-3.1 {dict get command} {dict get {a b} a} b
test dict-3.2 {dict get command} {dict get {a b c d} a} b
test dict-3.3 {dict get command} {dict get {a b c d} c} d
-test dict-3.4 {dict get command} {
- list [catch {dict get {a b c d} b} msg] $msg
-} {1 {key "b" not known in dictionary}}
+test dict-3.4 {dict get command} -returnCodes error -body {
+ dict get {a b c d} b
+} -result {key "b" not known in dictionary}
test dict-3.5 {dict get command} {dict get {a {p q r s} b {u v x y}} a p} q
test dict-3.6 {dict get command} {dict get {a {p q r s} b {u v x y}} a r} s
test dict-3.7 {dict get command} {dict get {a {p q r s} b {u v x y}} b u} v
test dict-3.8 {dict get command} {dict get {a {p q r s} b {u v x y}} b x} y
-test dict-3.9 {dict get command} {
- list [catch {dict get {a {p q r s} b {u v x y}} a z} msg] $msg
-} {1 {key "z" not known in dictionary}}
-test dict-3.10 {dict get command} {
- list [catch {dict get {a {p q r s} b {u v x y}} c z} msg] $msg
-} {1 {key "c" not known in dictionary}}
+test dict-3.9 {dict get command} -returnCodes error -body {
+ dict get {a {p q r s} b {u v x y}} a z
+} -result {key "z" not known in dictionary}
+test dict-3.10 {dict get command} -returnCodes error -body {
+ dict get {a {p q r s} b {u v x y}} c z
+} -result {key "c" not known in dictionary}
test dict-3.11 {dict get command} {dict get [dict create a b c d] a} b
-test dict-3.12 {dict get command} {
- list [catch {dict get} msg] $msg
-} {1 {wrong # args: should be "dict get dictionary ?key key ...?"}}
-test dict-3.13 {dict get command} {
+test dict-3.12 {dict get command} -returnCodes error -body {
+ dict get
+} -result {wrong # args: should be "dict get dictionary ?key ...?"}
+test dict-3.13 {dict get command} -body {
set dict [dict get {a b c d}]
if {$dict eq "a b c d"} {
- subst OK
+ return OK
} elseif {$dict eq "c d a b"} {
- subst OK
+ return reordered
} else {
- set dict
+ return $dict
}
-} OK
-test dict-3.14 {dict get command} {
- list [catch {dict get {a b c d} a c} msg] $msg
-} {1 {missing value to go with key}}
+} -cleanup {
+ unset dict
+} -result OK
+test dict-3.14 {dict get command} -returnCodes error -body {
+ dict get {a b c d} a c
+} -result {missing value to go with key}
test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body {
apply {{} {
dict set a(z) b c
@@ -132,43 +142,107 @@ test dict-3.16 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];di
test dict-3.17 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;llength $l} 6
test dict-4.1 {dict replace command} {
- getOrder [dict replace {a b c d}] a c
-} {a b c d 2}
+ dict replace {a b c d}
+} {a b c d}
test dict-4.2 {dict replace command} {
- getOrder [dict replace {a b c d} e f] a c e
-} {a b c d e f 3}
+ dict replace {a b c d} e f
+} {a b c d e f}
test dict-4.3 {dict replace command} {
- getOrder [dict replace {a b c d} c f] a c
-} {a b c f 2}
+ dict replace {a b c d} c f
+} {a b c f}
test dict-4.4 {dict replace command} {
- getOrder [dict replace {a b c d} c x a y] a c
-} {a y c x 2}
-test dict-4.5 {dict replace command} {
- list [catch {dict replace} msg] $msg
-} {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}}
-test dict-4.6 {dict replace command} {
- list [catch {dict replace {a a} a} msg] $msg
-} {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}}
-test dict-4.7 {dict replace command} {
- list [catch {dict replace {a a a} a b} msg] $msg
-} {1 {missing value to go with key}}
-test dict-4.8 {dict replace command} {
- list [catch {dict replace [list a a a] a b} msg] $msg
-} {1 {missing value to go with key}}
+ dict replace {a b c d} c x a y
+} {a y c x}
+test dict-4.5 {dict replace command} -returnCodes error -body {
+ dict replace
+} -result {wrong # args: should be "dict replace dictionary ?key value ...?"}
+test dict-4.6 {dict replace command} -returnCodes error -body {
+ dict replace {a a} a
+} -result {wrong # args: should be "dict replace dictionary ?key value ...?"}
+test dict-4.7 {dict replace command} -returnCodes error -body {
+ dict replace {a a a} a b
+} -result {missing value to go with key}
+test dict-4.8 {dict replace command} -returnCodes error -body {
+ dict replace [list a a a] a b
+} -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 is forced} {
+ dict replace { a b c d }
+} {a b c d}
+test dict-4.12 {dict replace command: canonicality is forced} {
+ dict replace {a b c d a e}
+} {a e 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 {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 JUNK}
+test dict-4.15 {dict replace command: type check is mandatory} -body {
+ dict replace { a b ""c d }
+} -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 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 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 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 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 BRACE}
+test dict-4.18 {dict replace command: canonicality forcing doesn't leak} {
+ set example { a b c d }
+ list $example [dict replace $example]
+} {{ a b c d } {a b c d}}
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}
test dict-5.3 {dict remove command} {dict remove {a b c d} a c} {}
test dict-5.4 {dict remove command} {dict remove {a b c d} c a} {}
test dict-5.5 {dict remove command} {
- getOrder [dict remove {a b c d}] a c
-} {a b c d 2}
+ dict remove {a b c d}
+} {a b c d}
test dict-5.6 {dict remove command} {dict remove {a b} c} {a b}
-test dict-5.7 {dict remove command} {
- list [catch {dict remove} msg] $msg
-} {1 {wrong # args: should be "dict remove dictionary ?key ...?"}}
+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 is forced} {
+ dict remove { a b c d }
+} {a b c d}
+test dict-5.9 {dict remove command: canonicality is forced} {
+ dict remove {a b c d a e}
+} {a e 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 {dict element in braces followed by "c" instead of space}
+test dict-5.13 {dict remove command: canonicality forcing doesn't leak} {
+ set example { a b c d }
+ list $example [dict remove $example]
+} {{ a b c d } {a b c d}}
test dict-6.1 {dict keys command} {dict keys {a b}} a
test dict-6.2 {dict keys command} {dict keys {c d}} c
@@ -177,15 +251,15 @@ test dict-6.4 {dict keys command} {dict keys {a b c d} a} a
test dict-6.5 {dict keys command} {dict keys {a b c d} c} c
test dict-6.6 {dict keys command} {dict keys {a b c d} e} {}
test dict-6.7 {dict keys command} {lsort [dict keys {a b c d ca da} c*]} {c ca}
-test dict-6.8 {dict keys command} {
- list [catch {dict keys} msg] $msg
-} {1 {wrong # args: should be "dict keys dictionary ?pattern?"}}
-test dict-6.9 {dict keys command} {
- list [catch {dict keys {} a b} msg] $msg
-} {1 {wrong # args: should be "dict keys dictionary ?pattern?"}}
-test dict-6.10 {dict keys command} {
- list [catch {dict keys a} msg] $msg
-} {1 {missing value to go with key}}
+test dict-6.8 {dict keys command} -returnCodes error -body {
+ dict keys
+} -result {wrong # args: should be "dict keys dictionary ?pattern?"}
+test dict-6.9 {dict keys command} -returnCodes error -body {
+ dict keys {} a b
+} -result {wrong # args: should be "dict keys dictionary ?pattern?"}
+test dict-6.10 {dict keys command} -returnCodes error -body {
+ dict keys a
+} -result {missing value to go with key}
test dict-7.1 {dict values command} {dict values {a b}} b
test dict-7.2 {dict values command} {dict values {c d}} d
@@ -194,28 +268,28 @@ test dict-7.4 {dict values command} {dict values {a b c d} b} b
test dict-7.5 {dict values command} {dict values {a b c d} d} d
test dict-7.6 {dict values command} {dict values {a b c d} e} {}
test dict-7.7 {dict values command} {lsort [dict values {a b c d ca da} d*]} {d da}
-test dict-7.8 {dict values command} {
- list [catch {dict values} msg] $msg
-} {1 {wrong # args: should be "dict values dictionary ?pattern?"}}
-test dict-7.9 {dict values command} {
- list [catch {dict values {} a b} msg] $msg
-} {1 {wrong # args: should be "dict values dictionary ?pattern?"}}
-test dict-7.10 {dict values command} {
- list [catch {dict values a} msg] $msg
-} {1 {missing value to go with key}}
+test dict-7.8 {dict values command} -returnCodes error -body {
+ dict values
+} -result {wrong # args: should be "dict values dictionary ?pattern?"}
+test dict-7.9 {dict values command} -returnCodes error -body {
+ dict values {} a b
+} -result {wrong # args: should be "dict values dictionary ?pattern?"}
+test dict-7.10 {dict values command} -returnCodes error -body {
+ dict values a
+} -result {missing value to go with key}
test dict-8.1 {dict size command} {dict size {}} 0
test dict-8.2 {dict size command} {dict size {a b}} 1
test dict-8.3 {dict size command} {dict size {a b c d}} 2
-test dict-8.4 {dict size command} {
- list [catch {dict size} msg] $msg
-} {1 {wrong # args: should be "dict size dictionary"}}
-test dict-8.5 {dict size command} {
- list [catch {dict size a b} msg] $msg
-} {1 {wrong # args: should be "dict size dictionary"}}
-test dict-8.6 {dict size command} {
- list [catch {dict size a} msg] $msg
-} {1 {missing value to go with key}}
+test dict-8.4 {dict size command} -returnCodes error -body {
+ dict size
+} -result {wrong # args: should be "dict size dictionary"}
+test dict-8.5 {dict size command} -returnCodes error -body {
+ dict size a b
+} -result {wrong # args: should be "dict size dictionary"}
+test dict-8.6 {dict size command} -returnCodes error -body {
+ dict size a
+} -result {missing value to go with key}
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
@@ -223,238 +297,303 @@ 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} {dict exists {a {b c}} b c} 0
test dict-9.6 {dict exists command} {dict exists {a {b c d}} a c} 0
-test dict-9.7 {dict exists command} {
- list [catch {dict exists} msg] $msg
-} {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}}
-test dict-9.8 {dict exists command} {
- list [catch {dict exists {}} msg] $msg
-} {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}}
+test dict-9.7 {dict exists command} -returnCodes error -body {
+ dict exists
+} -result {wrong # args: should be "dict exists dictionary key ?key ...?"}
+test dict-9.8 {dict exists command} -returnCodes error -body {
+ dict exists {}
+} -result {wrong # args: should be "dict exists dictionary key ?key ...?"}
-test dict-10.1 {dict info command} {
+test dict-10.1 {dict info command} -body {
# Actual string returned by this command is undefined; it is
# intended for human consumption and not for use by scripts.
dict info {}
- subst {}
-} {}
-test dict-10.2 {dict info command} {
- list [catch {dict info} msg] $msg
-} {1 {wrong # args: should be "dict info dictionary"}}
-test dict-10.3 {dict info command} {
- list [catch {dict info {} x} msg] $msg
-} {1 {wrong # args: should be "dict info dictionary"}}
-test dict-10.4 {dict info command} {
- list [catch {dict info x} msg] $msg
-} {1 {missing value to go with key}}
+} -match glob -result *
+test dict-10.2 {dict info command} -returnCodes error -body {
+ dict info
+} -result {wrong # args: should be "dict info dictionary"}
+test dict-10.3 {dict info command} -returnCodes error -body {
+ dict info {} x
+} -result {wrong # args: should be "dict info dictionary"}
+test dict-10.4 {dict info command} -returnCodes error -body {
+ dict info x
+} -result {missing value to go with key}
-test dict-11.1 {dict incr command: unshared value} {
+test dict-11.1 {dict incr command: unshared value} -body {
set dictv [dict create \
a [string index "=0=" 1] \
b [expr {1+2}] \
c [expr {wide(0x80000000)+1}]]
- getOrder [dict incr dictv a] a b c
-} {a 1 b 3 c 2147483649 3}
-test dict-11.2 {dict incr command: unshared value} {
+ dict incr dictv a
+} -cleanup {
+ unset dictv
+} -result {a 1 b 3 c 2147483649}
+test dict-11.2 {dict incr command: unshared value} -body {
set dictv [dict create \
a [string index "=0=" 1] \
b [expr {1+2}] \
c [expr {wide(0x80000000)+1}]]
- getOrder [dict incr dictv b] a b c
-} {a 0 b 4 c 2147483649 3}
-test dict-11.3 {dict incr command: unshared value} {
+ dict incr dictv b
+} -cleanup {
+ unset dictv
+} -result {a 0 b 4 c 2147483649}
+test dict-11.3 {dict incr command: unshared value} -body {
set dictv [dict create \
a [string index "=0=" 1] \
b [expr {1+2}] \
c [expr {wide(0x80000000)+1}]]
- getOrder [dict incr dictv c] a b c
-} {a 0 b 3 c 2147483650 3}
-test dict-11.4 {dict incr command: shared value} {
+ dict incr dictv c
+} -cleanup {
+ unset dictv
+} -result {a 0 b 3 c 2147483650}
+test dict-11.4 {dict incr command: shared value} -body {
set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
set sharing [dict values $dictv]
- getOrder [dict incr dictv a] a b c
-} {a 1 b 3 c 2147483649 3}
-test dict-11.5 {dict incr command: shared value} {
+ dict incr dictv a
+} -cleanup {
+ unset dictv sharing
+} -result {a 1 b 3 c 2147483649}
+test dict-11.5 {dict incr command: shared value} -body {
set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
set sharing [dict values $dictv]
- getOrder [dict incr dictv b] a b c
-} {a 0 b 4 c 2147483649 3}
-test dict-11.6 {dict incr command: shared value} {
+ dict incr dictv b
+} -cleanup {
+ unset dictv sharing
+} -result {a 0 b 4 c 2147483649}
+test dict-11.6 {dict incr command: shared value} -body {
set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
set sharing [dict values $dictv]
- getOrder [dict incr dictv c] a b c
-} {a 0 b 3 c 2147483650 3}
-test dict-11.7 {dict incr command: unknown values} {
+ dict incr dictv c
+} -cleanup {
+ unset dictv sharing
+} -result {a 0 b 3 c 2147483650}
+test dict-11.7 {dict incr command: unknown values} -body {
set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
- getOrder [dict incr dictv d] a b c d
-} {a 0 b 3 c 2147483649 d 1 4}
-test dict-11.8 {dict incr command} {
+ dict incr dictv d
+} -cleanup {
+ unset dictv
+} -result {a 0 b 3 c 2147483649 d 1}
+test dict-11.8 {dict incr command} -body {
set dictv {a 1}
dict incr dictv a 2
-} {a 3}
-test dict-11.9 {dict incr command} {
+} -cleanup {
+ unset dictv
+} -result {a 3}
+test dict-11.9 {dict incr command} -returnCodes error -body {
set dictv {a dummy}
- list [catch {dict incr dictv a} msg] $msg
-} {1 {expected integer but got "dummy"}}
-test dict-11.10 {dict incr command} {
+ dict incr dictv a
+} -cleanup {
+ unset dictv
+} -result {expected integer but got "dummy"}
+test dict-11.10 {dict incr command} -returnCodes error -body {
set dictv {a 1}
- list [catch {dict incr dictv a dummy} msg] $msg
-} {1 {expected integer but got "dummy"}}
-test dict-11.11 {dict incr command} {
- catch {unset dictv}
+ dict incr dictv a dummy
+} -cleanup {
+ unset dictv
+} -result {expected integer but got "dummy"}
+test dict-11.11 {dict incr command} -setup {
+ unset -nocomplain dictv
+} -body {
dict incr dictv a
-} {a 1}
-test dict-11.12 {dict incr command} {
+} -cleanup {
+ unset dictv
+} -result {a 1}
+test dict-11.12 {dict incr command} -returnCodes error -body {
set dictv a
- list [catch {dict incr dictv a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-11.13 {dict incr command} {
+ dict incr dictv a
+} -cleanup {
+ unset dictv
+} -result {missing value to go with key}
+test dict-11.13 {dict incr command} -returnCodes error -body {
set dictv a
- list [catch {dict incr dictv a a a} msg] $msg
-} {1 {wrong # args: should be "dict incr varName key ?increment?"}}
-test dict-11.14 {dict incr command} {
+ dict incr dictv a a a
+} -cleanup {
+ unset dictv
+} -result {wrong # args: should be "dict incr dictVarName key ?increment?"}
+test dict-11.14 {dict incr command} -returnCodes error -body {
set dictv a
- list [catch {dict incr dictv} msg] $msg
-} {1 {wrong # args: should be "dict incr varName key ?increment?"}}
-test dict-11.15 {dict incr command: write failure} {
- catch {unset dictVar}
+ dict incr dictv
+} -cleanup {
+ unset dictv
+} -result {wrong # args: should be "dict incr dictVarName key ?increment?"}
+test dict-11.15 {dict incr command: write failure} -setup {
+ unset -nocomplain dictVar
+} -body {
set dictVar(block) {}
- set result [list [catch {dict incr dictVar a} msg] $msg]
- catch {unset dictVar}
- set result
-} {1 {can't set "dictVar": variable is array}}
+ dict incr dictVar a
+} -returnCodes error -cleanup {
+ unset dictVar
+} -result {can't set "dictVar": variable is array}
test dict-11.16 {dict incr command: compilation} {
- proc dicttest {} {
+ apply {{} {
set v {a 0 b 0 c 0}
dict incr v a
dict incr v b 1
dict incr v c 2
dict incr v d 3
list [dict get $v a] [dict get $v b] [dict get $v c] [dict get $v d]
- }
- dicttest
+ }}
} {1 1 2 3}
test dict-11.17 {dict incr command: compilation} {
- proc dicttest {} {
+ apply {{} {
set dictv {a 1}
dict incr dictv a 2
- }
- dicttest
+ }}
} {a 3}
-test dict-12.1 {dict lappend command} {
+test dict-12.1 {dict lappend command} -body {
set dictv {a a}
dict lappend dictv a
-} {a a}
-test dict-12.2 {dict lappend command} {
+} -cleanup {
+ unset dictv
+} -result {a a}
+test dict-12.2 {dict lappend command} -body {
set dictv {a a}
set sharing [dict values $dictv]
dict lappend dictv a b
-} {a {a b}}
-test dict-12.3 {dict lappend command} {
+} -cleanup {
+ unset dictv sharing
+} -result {a {a b}}
+test dict-12.3 {dict lappend command} -body {
set dictv {a a}
dict lappend dictv a b c
-} {a {a b c}}
-test dict-12.2.1 {dict lappend command} {
+} -cleanup {
+ unset dictv
+} -result {a {a b c}}
+test dict-12.2.1 {dict lappend command} -body {
set dictv [dict create a [string index =a= 1]]
dict lappend dictv a b
-} {a {a b}}
-test dict-12.4 {dict lappend command} {
+} -cleanup {
+ unset dictv
+} -result {a {a b}}
+test dict-12.4 {dict lappend command} -body {
set dictv {}
dict lappend dictv a x y z
-} {a {x y z}}
-test dict-12.5 {dict lappend command} {
- catch {unset dictv}
+} -cleanup {
+ unset dictv
+} -result {a {x y z}}
+test dict-12.5 {dict lappend command} -body {
+ unset -nocomplain dictv
dict lappend dictv a b
-} {a b}
-test dict-12.6 {dict lappend command} {
+} -cleanup {
+ unset dictv
+} -result {a b}
+test dict-12.6 {dict lappend command} -returnCodes error -body {
set dictv a
- list [catch {dict lappend dictv a a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-12.7 {dict lappend command} {
- list [catch {dict lappend} msg] $msg
-} {1 {wrong # args: should be "dict lappend varName key ?value ...?"}}
-test dict-12.8 {dict lappend command} {
- list [catch {dict lappend dictv} msg] $msg
-} {1 {wrong # args: should be "dict lappend varName key ?value ...?"}}
-test dict-12.9 {dict lappend command} {
+ dict lappend dictv a a
+} -cleanup {
+ unset dictv
+} -result {missing value to go with key}
+test dict-12.7 {dict lappend command} -returnCodes error -body {
+ dict lappend
+} -result {wrong # args: should be "dict lappend dictVarName key ?value ...?"}
+test dict-12.8 {dict lappend command} -returnCodes error -body {
+ dict lappend dictv
+} -result {wrong # args: should be "dict lappend dictVarName key ?value ...?"}
+test dict-12.9 {dict lappend command} -returnCodes error -body {
set dictv [dict create a "\{"]
- list [catch {dict lappend dictv a a} msg] $msg
-} {1 {unmatched open brace in list}}
-test dict-12.10 {dict lappend command: write failure} {
- catch {unset dictVar}
+ dict lappend dictv a a
+} -cleanup {
+ unset dictv
+} -result {unmatched open brace in list}
+test dict-12.10 {dict lappend command: write failure} -setup {
+ unset -nocomplain dictVar
+} -body {
set dictVar(block) {}
- set result [list [catch {dict lappend dictVar a x} msg] $msg]
- catch {unset dictVar}
- set result
-} {1 {can't set "dictVar": variable is array}}
+ dict lappend dictVar a x
+} -returnCodes error -cleanup {
+ unset dictVar
+} -result {can't set "dictVar": variable is array}
+test dict-12.11 {compiled dict append: invalidate string rep - Bug 3079830} {
+ apply {{} {set d {a 1 b 2 c 3}; dict lappend d b 22}}
+} {a 1 b {2 22} c 3}
-test dict-13.1 {dict append command} {
+test dict-13.1 {dict append command} -body {
set dictv {a a}
dict append dictv a
-} {a a}
-test dict-13.2 {dict append command} {
+} -cleanup {
+ unset dictv
+} -result {a a}
+test dict-13.2 {dict append command} -body {
set dictv {a a}
set sharing [dict values $dictv]
dict append dictv a b
-} {a ab}
-test dict-13.3 {dict append command} {
+} -cleanup {
+ unset dictv sharing
+} -result {a ab}
+test dict-13.3 {dict append command} -body {
set dictv {a a}
dict append dictv a b c
-} {a abc}
-test dict-13.2.1 {dict append command} {
+} -cleanup {
+ unset dictv
+} -result {a abc}
+test dict-13.2.1 {dict append command} -body {
set dictv [dict create a [string index =a= 1]]
dict append dictv a b
-} {a ab}
-test dict-13.4 {dict append command} {
+} -cleanup {
+ unset dictv
+} -result {a ab}
+test dict-13.4 {dict append command} -body {
set dictv {}
dict append dictv a x y z
-} {a xyz}
-test dict-13.5 {dict append command} {
- catch {unset dictv}
+} -cleanup {
+ unset dictv
+} -result {a xyz}
+test dict-13.5 {dict append command} -body {
+ unset -nocomplain dictv
dict append dictv a b
-} {a b}
-test dict-13.6 {dict append command} {
+} -cleanup {
+ unset dictv
+} -result {a b}
+test dict-13.6 {dict append command} -returnCodes error -body {
set dictv a
- list [catch {dict append dictv a a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-13.7 {dict append command} {
- list [catch {dict append} msg] $msg
-} {1 {wrong # args: should be "dict append varName key ?value ...?"}}
-test dict-13.8 {dict append command} {
- list [catch {dict append dictv} msg] $msg
-} {1 {wrong # args: should be "dict append varName key ?value ...?"}}
-test dict-13.9 {dict append command: write failure} {
- catch {unset dictVar}
+ dict append dictv a a
+} -cleanup {
+ unset dictv
+} -result {missing value to go with key}
+test dict-13.7 {dict append command} -returnCodes error -body {
+ dict append
+} -result {wrong # args: should be "dict append dictVarName key ?value ...?"}
+test dict-13.8 {dict append command} -returnCodes error -body {
+ dict append dictv
+} -result {wrong # args: should be "dict append dictVarName key ?value ...?"}
+test dict-13.9 {dict append command: write failure} -setup {
+ unset -nocomplain dictVar
+} -body {
set dictVar(block) {}
- set result [list [catch {dict append dictVar a x} msg] $msg]
- catch {unset dictVar}
- set result
-} {1 {can't set "dictVar": variable is array}}
-test dict-13.10 {compiled dict command: crash case} {
+ dict append dictVar a x
+} -returnCodes error -cleanup {
+ unset dictVar
+} -result {can't set "dictVar": variable is array}
+test dict-13.10 {compiled dict append: crash case} {
apply {{} {dict append dictVar a o k}}
} {a ok}
+test dict-13.11 {compiled dict append: invalidate string rep - Bug 3079830} {
+ apply {{} {set d {a 1 b 2 c 3}; dict append d b 22}}
+} {a 1 b 222 c 3}
-test dict-14.1 {dict for command: syntax} {
- list [catch {dict for} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.2 {dict for command: syntax} {
- list [catch {dict for x} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.3 {dict for command: syntax} {
- list [catch {dict for x x} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.4 {dict for command: syntax} {
- list [catch {dict for x x x x} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.5 {dict for command: syntax} {
- list [catch {dict for x x x} msg] $msg
-} {1 {must have exactly two variable names}}
-test dict-14.6 {dict for command: syntax} {
- list [catch {dict for {x x x} x x} msg] $msg
-} {1 {must have exactly two variable names}}
-test dict-14.7 {dict for command: syntax} {
- list [catch {dict for "\{x" x x} msg] $msg
-} {1 {unmatched open brace in list}}
-test dict-14.8 {dict for command} {
+test dict-14.1 {dict for command: syntax} -returnCodes error -body {
+ dict for
+} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
+test dict-14.2 {dict for command: syntax} -returnCodes error -body {
+ dict for x
+} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
+test dict-14.3 {dict for command: syntax} -returnCodes error -body {
+ dict for x x
+} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
+test dict-14.4 {dict for command: syntax} -returnCodes error -body {
+ dict for x x x x
+} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
+test dict-14.5 {dict for command: syntax} -returnCodes error -body {
+ dict for x x x
+} -result {must have exactly two variable names}
+test dict-14.6 {dict for command: syntax} -returnCodes error -body {
+ dict for {x x x} x x
+} -result {must have exactly two variable names}
+test dict-14.7 {dict for command: syntax} -returnCodes error -body {
+ dict for "\{x" x x
+} -result {unmatched open brace in list}
+test dict-14.8 {dict for command} -body {
# This test confirms that [dict keys], [dict values] and [dict for]
# all traverse a dictionary in the same order.
set dictv {a A b B c C}
@@ -468,31 +607,37 @@ test dict-14.8 {dict for command} {
$keys eq [dict keys $dictv] && $values eq [dict values $dictv]
}]
expr {$result ? "YES" : [list "NO" $dictv $keys $values]}
-} YES
+} -cleanup {
+ unset result keys values k v dictv
+} -result YES
test dict-14.9 {dict for command} {
dict for {k v} {} {
error "unexpected execution of 'dict for' body"
}
} {}
-test dict-14.10 {dict for command: script results} {
+test dict-14.10 {dict for command: script results} -body {
set times 0
dict for {k v} {a a b b} {
incr times
continue
error "shouldn't get here"
}
- set times
-} 2
-test dict-14.11 {dict for command: script results} {
+ return $times
+} -cleanup {
+ unset times k v
+} -result 2
+test dict-14.11 {dict for command: script results} -body {
set times 0
dict for {k v} {a a b b} {
incr times
break
error "shouldn't get here"
}
- set times
-} 1
-test dict-14.12 {dict for command: script results} {
+ return $times
+} -cleanup {
+ unset times k v
+} -result 1
+test dict-14.12 {dict for command: script results} -body {
set times 0
list [catch {
dict for {k v} {a a b b} {
@@ -500,7 +645,9 @@ test dict-14.12 {dict for command: script results} {
error test
}
} msg] $msg $times $::errorInfo
-} {1 test 1 {test
+} -cleanup {
+ unset times k v msg
+} -result {1 test 1 {test
while executing
"error test"
("dict for" body line 3)
@@ -510,17 +657,15 @@ test dict-14.12 {dict for command: script results} {
error test
}"}}
test dict-14.13 {dict for command: script results} {
- proc dicttest {} {
- rename dicttest {}
+ apply {{} {
dict for {k v} {a b} {
return ok,$k,$v
error "skipped return completely"
}
error "return didn't go far enough"
- }
- dicttest
+ }}
} ok,a,b
-test dict-14.14 {dict for command: handle representation loss} {
+test dict-14.14 {dict for command: handle representation loss} -body {
set dictVar {a b c d e f g h}
set keys {}
set values {}
@@ -531,11 +676,14 @@ test dict-14.14 {dict for command: handle representation loss} {
}
}
list [lsort $keys] [lsort $values]
-} {{a c e g} {b d f h}}
-test dict-14.15 {dict for command: keys are unique and iterated over once only} {
- set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
- catch {unset accum}
+} -cleanup {
+ unset dictVar keys values k v
+} -result {{a c e g} {b d f h}}
+test dict-14.15 {dict for command: keys are unique and iterated over once only} -setup {
+ unset -nocomplain accum
array set accum {}
+} -body {
+ set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
dict for {k v} $dictVar {
append accum($k) $v,
}
@@ -544,399 +692,533 @@ test dict-14.15 {dict for command: keys are unique and iterated over once only}
foreach k $result {
catch {lappend result $accum($k)}
}
- catch {unset accum}
- set result
-} {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
+ return $result
+} -cleanup {
+ unset dictVar k v result accum
+} -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
test dict-14.16 {dict for command in compilation context} {
- proc dicttest {} {
+ apply {{} {
set res {x x x x x x}
dict for {k v} {a 0 b 1 c 2 d 3 e 4 f 5} {
lset res $v $k
continue
}
return $res
- }
- dicttest
+ }}
} {a b c d e f}
test dict-14.17 {dict for command in compilation context} {
# Bug 1379349
- proc dicttest {} {
+ apply {{} {
set d [dict create a 1] ;# Dict must be unshared!
dict for {k v} $d {
dict set d $k 0 ;# Any modification will do
}
return $d
- }
- dicttest
+ }}
} {a 0}
test dict-14.18 {dict for command in compilation context} {
# Bug 1382528
- proc dicttest {} {
+ apply {{} {
dict for {k v} {} {} ;# Note empty dict
catch { error foo } ;# Note compiled [catch]
- }
- dicttest
+ }}
} 1
test dict-14.19 {dict for and invalid dicts: bug 1531184} -body {
di[list]ct for {k v} x {}
} -returnCodes 1 -result {missing value to go with key}
test dict-14.20 {dict for stack space compilation: bug 1903325} {
- proc dicttest {x y args} {
+ apply {{x y args} {
dict for {a b} $x {}
concat "c=$y,$args"
- }
- dicttest {} 1 2 3
+ }} {} 1 2 3
} {c=1,2 3}
+test dict-14.21 {compiled dict for and break} {
+ apply {{} {
+ dict for {a b} {c d e f} {
+ lappend result $a,$b
+ break
+ }
+ return $result
+ }}
+} c,d
+test dict-14.22 {dict for and exception range depths: Bug 3614382} {
+ apply {{} {
+ dict for {a b} {c d} {
+ dict for {e f} {g h} {
+ return 5
+ }
+ }
+ }}
+} 5
# There's probably a lot more tests to add here. Really ought to use a
# coverage tool for this job...
-test dict-15.1 {dict set command} {
+test dict-15.1 {dict set command} -body {
set dictVar {}
dict set dictVar a x
-} {a x}
-test dict-15.2 {dict set command} {
+} -cleanup {
+ unset dictVar
+} -result {a x}
+test dict-15.2 {dict set command} -body {
set dictvar {a {}}
dict set dictvar a b x
-} {a {b x}}
-test dict-15.3 {dict set command} {
+} -cleanup {
+ unset dictvar
+} -result {a {b x}}
+test dict-15.3 {dict set command} -body {
set dictvar {a {b {}}}
dict set dictvar a b c x
-} {a {b {c x}}}
-test dict-15.4 {dict set command} {
+} -cleanup {
+ unset dictvar
+} -result {a {b {c x}}}
+test dict-15.4 {dict set command} -body {
set dictVar {a y}
dict set dictVar a x
-} {a x}
-test dict-15.5 {dict set command} {
+} -cleanup {
+ unset dictVar
+} -result {a x}
+test dict-15.5 {dict set command} -body {
set dictVar {a {b y}}
dict set dictVar a b x
-} {a {b x}}
-test dict-15.6 {dict set command} {
+} -cleanup {
+ unset dictVar
+} -result {a {b x}}
+test dict-15.6 {dict set command} -body {
set dictVar {a {b {c y}}}
dict set dictVar a b c x
-} {a {b {c x}}}
-test dict-15.7 {dict set command: path creation} {
+} -cleanup {
+ unset dictVar
+} -result {a {b {c x}}}
+test dict-15.7 {dict set command: path creation} -body {
set dictVar {}
dict set dictVar a b x
-} {a {b x}}
-test dict-15.8 {dict set command: creates variables} {
- catch {unset dictVar}
+} -cleanup {
+ unset dictVar
+} -result {a {b x}}
+test dict-15.8 {dict set command: creates variables} -setup {
+ unset -nocomplain dictVar
+} -body {
dict set dictVar a x
- set dictVar
-} {a x}
-test dict-15.9 {dict set command: write failure} {
- catch {unset dictVar}
+ return $dictVar
+} -cleanup {
+ unset dictVar
+} -result {a x}
+test dict-15.9 {dict set command: write failure} -setup {
+ unset -nocomplain dictVar
+} -body {
set dictVar(block) {}
- set result [list [catch {dict set dictVar a x} msg] $msg]
- catch {unset dictVar}
- set result
-} {1 {can't set "dictVar": variable is array}}
-test dict-15.10 {dict set command: syntax} {
- list [catch {dict set} msg] $msg
-} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
-test dict-15.11 {dict set command: syntax} {
- list [catch {dict set a} msg] $msg
-} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
-test dict-15.12 {dict set command: syntax} {
- list [catch {dict set a a} msg] $msg
-} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
-test dict-15.13 {dict set command} {
+ dict set dictVar a x
+} -returnCodes error -cleanup {
+ unset dictVar
+} -result {can't set "dictVar": variable is array}
+test dict-15.10 {dict set command: syntax} -returnCodes error -body {
+ dict set
+} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
+test dict-15.11 {dict set command: syntax} -returnCodes error -body {
+ dict set a
+} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
+test dict-15.12 {dict set command: syntax} -returnCodes error -body {
+ dict set a a
+} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
+test dict-15.13 {dict set command} -returnCodes error -body {
set dictVar a
- list [catch {dict set dictVar b c} msg] $msg
-} {1 {missing value to go with key}}
+ dict set dictVar b c
+} -cleanup {
+ unset dictVar
+} -result {missing value to go with key}
-test dict-16.1 {dict unset command} {
+test dict-16.1 {dict unset command} -body {
set dictVar {a b c d}
dict unset dictVar a
-} {c d}
-test dict-16.2 {dict unset command} {
+} -cleanup {
+ unset dictVar
+} -result {c d}
+test dict-16.2 {dict unset command} -body {
set dictVar {a b c d}
dict unset dictVar c
-} {a b}
-test dict-16.3 {dict unset command} {
+} -cleanup {
+ unset dictVar
+} -result {a b}
+test dict-16.3 {dict unset command} -body {
set dictVar {a b}
dict unset dictVar c
-} {a b}
-test dict-16.4 {dict unset command} {
+} -cleanup {
+ unset dictVar
+} -result {a b}
+test dict-16.4 {dict unset command} -body {
set dictVar {a {b c d e}}
dict unset dictVar a b
-} {a {d e}}
-test dict-16.5 {dict unset command} {
+} -cleanup {
+ unset dictVar
+} -result {a {d e}}
+test dict-16.5 {dict unset command} -returnCodes error -body {
set dictVar a
- list [catch {dict unset dictVar a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-16.6 {dict unset command} {
+ dict unset dictVar a
+} -cleanup {
+ unset dictVar
+} -result {missing value to go with key}
+test dict-16.6 {dict unset command} -returnCodes error -body {
set dictVar {a b}
- list [catch {dict unset dictVar c d} msg] $msg
-} {1 {key "c" not known in dictionary}}
-test dict-16.7 {dict unset command} {
- catch {unset dictVar}
+ dict unset dictVar c d
+} -cleanup {
+ unset dictVar
+} -result {key "c" not known in dictionary}
+test dict-16.7 {dict unset command} -setup {
+ unset -nocomplain dictVar
+} -body {
list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]
-} {0 {} 1}
-test dict-16.8 {dict unset command} {
- list [catch {dict unset dictVar} msg] $msg
-} {1 {wrong # args: should be "dict unset varName key ?key ...?"}}
-test dict-16.9 {dict unset command: write failure} {
- catch {unset dictVar}
+} -cleanup {
+ unset dictVar
+} -result {0 {} 1}
+test dict-16.8 {dict unset command} -returnCodes error -body {
+ dict unset dictVar
+} -result {wrong # args: should be "dict unset dictVarName key ?key ...?"}
+test dict-16.9 {dict unset command: write failure} -setup {
+ unset -nocomplain dictVar
+} -body {
set dictVar(block) {}
- set result [list [catch {dict unset dictVar a} msg] $msg]
- catch {unset dictVar}
- set result
-} {1 {can't set "dictVar": variable is array}}
+ dict unset dictVar a
+} -returnCodes error -cleanup {
+ unset dictVar
+} -result {can't set "dictVar": variable is array}
+# Now test with an LVT present (i.e., the bytecoded version).
+test dict-16.10 {dict unset command} -body {
+ apply {{} {
+ set dictVar {a b c d}
+ dict unset dictVar a
+ }}
+} -result {c d}
+test dict-16.11 {dict unset command} -body {
+ apply {{} {
+ set dictVar {a b c d}
+ dict unset dictVar c
+ }}
+} -result {a b}
+test dict-16.12 {dict unset command} -body {
+ apply {{} {
+ set dictVar {a b}
+ dict unset dictVar c
+ }}
+} -result {a b}
+test dict-16.13 {dict unset command} -body {
+ apply {{} {
+ set dictVar {a {b c d e}}
+ dict unset dictVar a b
+ }}
+} -result {a {d e}}
+test dict-16.14 {dict unset command} -returnCodes error -body {
+ apply {{} {
+ set dictVar a
+ dict unset dictVar a
+ }}
+} -result {missing value to go with key}
+test dict-16.15 {dict unset command} -returnCodes error -body {
+ apply {{} {
+ set dictVar {a b}
+ dict unset dictVar c d
+ }}
+} -result {key "c" not known in dictionary}
+test dict-16.16 {dict unset command} -body {
+ apply {{} {list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]}}
+} -result {0 {} 1}
+test dict-16.17 {dict unset command} -returnCodes error -body {
+ apply {{} {dict unset dictVar}}
+} -result {wrong # args: should be "dict unset dictVarName key ?key ...?"}
+test dict-16.18 {dict unset command: write failure} -body {
+ apply {{} {
+ set dictVar(block) {}
+ dict unset dictVar a
+ }}
+} -returnCodes error -result {can't set "dictVar": variable is array}
-test dict-17.1 {dict filter command: key} {
+test dict-17.1 {dict filter command: key} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
dict filter $dictVar key a2
-} {a2 b}
-test dict-17.2 {dict filter command: key} {
+} -cleanup {
+ unset dictVar
+} -result {a2 b}
+test dict-17.2 {dict filter command: key} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
dict size [dict filter $dictVar key *]
-} 6
-test dict-17.3 {dict filter command: key} {
+} -cleanup {
+ unset dictVar
+} -result 6
+test dict-17.3 {dict filter command: key} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
- getOrder [dict filter $dictVar key ???] bar foo
-} {bar foo foo bar 2}
-test dict-17.4 {dict filter command: key} {
- list [catch {dict filter {} key} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary key globPattern"}}
-test dict-17.5 {dict filter command: key} {
- list [catch {dict filter {} key a a} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary key globPattern"}}
-test dict-17.6 {dict filter command: value} {
+ dict filter $dictVar key ???
+} -cleanup {
+ unset dictVar
+} -result {foo bar bar foo}
+test dict-17.4 {dict filter command: key - no patterns} {
+ dict filter {a b c d} key
+} {}
+test dict-17.4.1 {dict filter command: key - many patterns} {
+ dict filter {a1 a a2 b b1 c b2 d foo bar bar foo} key a? b?
+} {a1 a a2 b b1 c b2 d}
+test dict-17.5 {dict filter command: key - bad dict} -returnCodes error -body {
+ dict filter {a b c} key
+} -result {missing value to go with key}
+test dict-17.6 {dict filter command: value} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
dict filter $dictVar value c
-} {b1 c}
-test dict-17.7 {dict filter command: value} {
+} -cleanup {
+ unset dictVar
+} -result {b1 c}
+test dict-17.7 {dict filter command: value} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
dict size [dict filter $dictVar value *]
-} 6
-test dict-17.8 {dict filter command: value} {
+} -cleanup {
+ unset dictVar
+} -result 6
+test dict-17.8 {dict filter command: value} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
- getOrder [dict filter $dictVar value ???] bar foo
-} {bar foo foo bar 2}
-test dict-17.9 {dict filter command: value} {
- list [catch {dict filter {} value} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary value globPattern"}}
-test dict-17.10 {dict filter command: value} {
- list [catch {dict filter {} value a a} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary value globPattern"}}
-test dict-17.11 {dict filter command: script} {
+ dict filter $dictVar value ???
+} -cleanup {
+ unset dictVar
+} -result {foo bar bar foo}
+test dict-17.9 {dict filter command: value - no patterns} {
+ dict filter {a b c d} value
+} {}
+test dict-17.9.1 {dict filter command: value - many patterns} {
+ dict filter {a a1 b a2 c b1 foo bar bar foo d b2} value a? b?
+} {a a1 b a2 c b1 d b2}
+test dict-17.10 {dict filter command: value - bad dict} -body {
+ dict filter {a b c} value a
+} -returnCodes error -result {missing value to go with key}
+test dict-17.11 {dict filter command: script} -body {
set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
set n 0
- list [getOrder [dict filter $dictVar script {k v} {
+ list [dict filter $dictVar script {k v} {
incr n
expr {[string length $k] == [string length $v]}
- }] bar foo] $n
-} {{bar foo foo bar 2} 6}
-test dict-17.12 {dict filter command: script} {
- list [catch {dict filter {a b} script {k v} {concat $k $v}} msg] $msg
-} {1 {expected boolean value but got "a b"}}
-test dict-17.13 {dict filter command: script} {
+ }] $n
+} -cleanup {
+ unset dictVar n k v
+} -result {{foo bar bar foo} 6}
+test dict-17.12 {dict filter command: script} -returnCodes error -body {
+ dict filter {a b} script {k v} {
+ concat $k $v
+ }
+} -cleanup {
+ unset k v
+} -result {expected boolean value but got "a b"}
+test dict-17.13 {dict filter command: script} -body {
list [catch {dict filter {a b} script {k v} {error x}} msg] $msg \
$::errorInfo
-} {1 x {x
+} -cleanup {
+ unset k v msg
+} -result {1 x {x
while executing
"error x"
("dict filter" script line 1)
invoked from within
"dict filter {a b} script {k v} {error x}"}}
-test dict-17.14 {dict filter command: script} {
+test dict-17.14 {dict filter command: script} -setup {
set n 0
+} -body {
list [dict filter {a b c d} script {k v} {
incr n
break
error boom!
}] $n
-} {{} 1}
-test dict-17.15 {dict filter command: script} {
+} -cleanup {
+ unset n k v
+} -result {{} 1}
+test dict-17.15 {dict filter command: script} -setup {
set n 0
+} -body {
list [dict filter {a b c d} script {k v} {
incr n
continue
error boom!
}] $n
-} {{} 2}
+} -cleanup {
+ unset n k v
+} -result {{} 2}
test dict-17.16 {dict filter command: script} {
- proc dicttest {} {
- rename dicttest {}
+ apply {{} {
dict filter {a b} script {k v} {
return ok,$k,$v
error "skipped return completely"
}
error "return didn't go far enough"
- }
- dicttest
+ }}
} ok,a,b
-test dict-17.17 {dict filter command: script} {
+test dict-17.17 {dict filter command: script} -body {
dict filter {a b} script {k k} {continue}
- set k
-} b
-test dict-17.18 {dict filter command: script} {
- list [catch {dict filter {a b} script {k k}} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary script {keyVar valueVar} filterScript"}}
-test dict-17.19 {dict filter command: script} {
- list [catch {dict filter {a b} script k {continue}} msg] $msg
-} {1 {must have exactly two variable names}}
-test dict-17.20 {dict filter command: script} {
- list [catch {dict filter {a b} script "\{k v" {continue}} msg] $msg
-} {1 {unmatched open brace in list}}
-test dict-17.21 {dict filter command} {
- list [catch {dict filter {a b}} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary filterType ..."}}
-test dict-17.22 {dict filter command} {
- list [catch {dict filter {a b} JUNK} msg] $msg
-} {1 {bad filterType "JUNK": must be key, script, or value}}
-test dict-17.23 {dict filter command} {
- list [catch {dict filter a key *} msg] $msg
-} {1 {missing value to go with key}}
+ return $k
+} -cleanup {
+ unset k
+} -result b
+test dict-17.18 {dict filter command: script} -returnCodes error -body {
+ dict filter {a b} script {k k}
+} -result {wrong # args: should be "dict filter dictionary script {keyVarName valueVarName} filterScript"}
+test dict-17.19 {dict filter command: script} -returnCodes error -body {
+ dict filter {a b} script k {continue}
+} -result {must have exactly two variable names}
+test dict-17.20 {dict filter command: script} -returnCodes error -body {
+ dict filter {a b} script "\{k v" {continue}
+} -result {unmatched open brace in list}
+test dict-17.21 {dict filter command} -returnCodes error -body {
+ dict filter {a b}
+} -result {wrong # args: should be "dict filter dictionary filterType ?arg ...?"}
+test dict-17.22 {dict filter command} -returnCodes error -body {
+ dict filter {a b} JUNK
+} -result {bad filterType "JUNK": must be key, script, or value}
+test dict-17.23 {dict filter command} -returnCodes error -body {
+ dict filter a key *
+} -result {missing value to go with key}
-test dict-18.1 {dict-list relationship} {
- -body {
- # Test that any internal conversion between list and dict
- # does not change the object
- set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y]
- dict values $l
- set l
- }
- -result {1 2 3 4 5 6 7 8 9 0 q w e r t y}
-}
-test dict-18.2 {dict-list relationship} {
- -body {
- # Test that the dictionary is a valid list
- set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2]
- for {set t 0} {$t < 5} {incr t} {
- llength $d
- dict lappend d "abc def" "\}\{"
- dict append d "a\{b" "\}"
- dict incr d "c\}d" 1
- }
- llength $d
+test dict-18.1 {dict-list relationship} -body {
+ # Test that any internal conversion between list and dict does not change
+ # the object
+ set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y]
+ dict values $l
+ return $l
+} -cleanup {
+ unset l
+} -result {1 2 3 4 5 6 7 8 9 0 q w e r t y}
+test dict-18.2 {dict-list relationship} -body {
+ # Test that the dictionary is a valid list
+ set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2]
+ for {set t 0} {$t < 5} {incr t} {
+ llength $d
+ dict lappend d "abc def" "\}\{"
+ dict append d "a\{b" "\}"
+ dict incr d "c\}d" 1
}
- -result 6
-}
+ llength $d
+} -cleanup {
+ unset d t
+} -result 6
+test dict-18.3 {dict-list relationship} -body {
+ set ld [list a b c d c e f g]
+ list [string length $ld] [dict size $ld] [llength $ld]
+} -cleanup {
+ unset ld
+} -result {15 3 8}
+test dict-18.4 {dict-list relationship} -body {
+ set ld [list a b c d c e f g]
+ list [llength $ld] [dict size $ld] [llength $ld]
+} -cleanup {
+ unset ld
+} -result {8 3 8}
# This is a test for a specific bug.
# It shows a bad ref counter when running with memdebug on.
-test dict-19.1 {memory bug} -setup {
- proc xxx {} {
+test dict-19.1 {memory bug} {
+ apply {{} {
set successors [dict create x {c d}]
dict set successors x a b
dict get $successors x
- }
-} -body {
- xxx
-} -cleanup {
- rename xxx {}
-} -result [dict create c d a b]
-test dict-19.2 {dict: testing for leaks} -setup {
+ }}
+} [dict create c d a b]
+test dict-19.2 {dict: testing for leaks} -constraints memory -body {
# This test is made to stress object reference management
- proc stress {} {
- # A shared invalid dictinary
- set apa {a {}b c d}
- set bepa $apa
- catch {dict replace $apa e f}
- catch {dict remove $apa c d}
- catch {dict incr apa a 5}
- catch {dict lappend apa a 5}
- catch {dict append apa a 5}
- catch {dict set apa a 5}
- catch {dict unset apa a}
+ memtest {
+ apply {{} {
+ # A shared invalid dictinary
+ set apa {a {}b c d}
+ set bepa $apa
+ catch {dict replace $apa e f}
+ catch {dict remove $apa c d}
+ catch {dict incr apa a 5}
+ catch {dict lappend apa a 5}
+ catch {dict append apa a 5}
+ catch {dict set apa a 5}
+ catch {dict unset apa a}
- # A shared valid dictionary, invalid incr
- set apa {a b c d}
- set bepa $apa
- catch {dict incr bepa a 5}
+ # A shared valid dictionary, invalid incr
+ set apa {a b c d}
+ set bepa $apa
+ catch {dict incr bepa a 5}
- # An error during write to an unshared object, incr
- set apa {a 1 b 2}
- set bepa [lrange $apa 0 end]
- trace add variable bepa write {error hej}
- catch {dict incr bepa a 5}
- trace remove variable bepa write {error hej}
- unset bepa
+ # An error during write to an unshared object, incr
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {dict incr bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to a shared object, incr
- set apa {a 1 b 2}
- set bepa $apa
- trace add variable bepa write {error hej}
- catch {dict incr bepa a 5}
- trace remove variable bepa write {error hej}
- unset bepa
+ # An error during write to a shared object, incr
+ set apa {a 1 b 2}
+ set bepa $apa
+ trace add variable bepa write {error hej}
+ catch {dict incr bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # A shared valid dictionary, invalid lappend
- set apa [list a {{}b} c d]
- set bepa $apa
- catch {dict lappend bepa a 5}
+ # A shared valid dictionary, invalid lappend
+ set apa [list a {{}b} c d]
+ set bepa $apa
+ catch {dict lappend bepa a 5}
- # An error during write to an unshared object, lappend
- set apa {a 1 b 2}
- set bepa [lrange $apa 0 end]
- trace add variable bepa write {error hej}
- catch {dict lappend bepa a 5}
- trace remove variable bepa write {error hej}
- unset bepa
+ # An error during write to an unshared object, lappend
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {dict lappend bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to a shared object, lappend
- set apa {a 1 b 2}
- set bepa $apa
- trace add variable bepa write {error hej}
- catch {dict lappend bepa a 5}
- trace remove variable bepa write {error hej}
- unset bepa
+ # An error during write to a shared object, lappend
+ set apa {a 1 b 2}
+ set bepa $apa
+ trace add variable bepa write {error hej}
+ catch {dict lappend bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to an unshared object, append
- set apa {a 1 b 2}
- set bepa [lrange $apa 0 end]
- trace add variable bepa write {error hej}
- catch {dict append bepa a 5}
- trace remove variable bepa write {error hej}
- unset bepa
+ # An error during write to an unshared object, append
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {dict append bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to a shared object, append
- set apa {a 1 b 2}
- set bepa $apa
- trace add variable bepa write {error hej}
- catch {dict append bepa a 5}
- trace remove variable bepa write {error hej}
- unset bepa
+ # An error during write to a shared object, append
+ set apa {a 1 b 2}
+ set bepa $apa
+ trace add variable bepa write {error hej}
+ catch {dict append bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to an unshared object, set
- set apa {a 1 b 2}
- set bepa [lrange $apa 0 end]
- trace add variable bepa write {error hej}
- catch {dict set bepa a 5}
- trace remove variable bepa write {error hej}
- unset bepa
+ # An error during write to an unshared object, set
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {dict set bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to a shared object, set
- set apa {a 1 b 2}
- set bepa $apa
- trace add variable bepa write {error hej}
- catch {dict set bepa a 5}
- trace remove variable bepa write {error hej}
- unset bepa
+ # An error during write to a shared object, set
+ set apa {a 1 b 2}
+ set bepa $apa
+ trace add variable bepa write {error hej}
+ catch {dict set bepa a 5}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to an unshared object, unset
- set apa {a 1 b 2}
- set bepa [lrange $apa 0 end]
- trace add variable bepa write {error hej}
- catch {dict unset bepa a}
- trace remove variable bepa write {error hej}
- unset bepa
+ # An error during write to an unshared object, unset
+ set apa {a 1 b 2}
+ set bepa [lrange $apa 0 end]
+ trace add variable bepa write {error hej}
+ catch {dict unset bepa a}
+ trace remove variable bepa write {error hej}
+ unset bepa
- # An error during write to a shared object, unset
- set apa {a 1 b 2}
- set bepa $apa
- trace add variable bepa write {error hej}
- catch {dict unset bepa a}
- trace remove variable bepa write {error hej}
- unset bepa
- }
-} -constraints memory -body {
- memtest {
- stress
+ # An error during write to a shared object, unset
+ set apa {a 1 b 2}
+ set bepa $apa
+ trace add variable bepa write {error hej}
+ catch {dict unset bepa a}
+ trace remove variable bepa write {error hej}
+ unset bepa
+ }}
}
-} -cleanup {
- rename stress {}
} -result 0
test dict-19.3 {testing for leaks - Bug 2874678} -constraints memory -body {
set d aDictVar; # Force interpreted [dict incr]
@@ -952,46 +1234,91 @@ test dict-20.1 {dict merge command} {
dict merge
} {}
test dict-20.2 {dict merge command} {
- getOrder [dict merge {a b c d e f}] a c e
-} {a b c d e f 3}
+ dict merge {a b c d e f}
+} {a b c d e f}
test dict-20.3 {dict merge command} -body {
dict merge {a b c d e}
-} -result {missing value to go with key} -returnCodes 1
+} -result {missing value to go with key} -returnCodes error
test dict-20.4 {dict merge command} {
- getOrder [dict merge {a b c d} {e f g h}] a c e g
-} {a b c d e f g h 4}
+ dict merge {a b c d} {e f g h}
+} {a b c d e f g h}
test dict-20.5 {dict merge command} -body {
dict merge {a b c d e} {e f g h}
-} -result {missing value to go with key} -returnCodes 1
+} -result {missing value to go with key} -returnCodes error
test dict-20.6 {dict merge command} -body {
dict merge {a b c d} {e f g h i}
-} -result {missing value to go with key} -returnCodes 1
+} -result {missing value to go with key} -returnCodes error
test dict-20.7 {dict merge command} {
- getOrder [dict merge {a b c d e f} {e x g h}] a c e g
-} {a b c d e x g h 4}
+ dict merge {a b c d e f} {e x g h}
+} {a b c d e x g h}
test dict-20.8 {dict merge command} {
- getOrder [dict merge {a b c d} {a x c y}] a c
-} {a x c y 2}
+ dict merge {a b c d} {a x c y}
+} {a x c y}
test dict-20.9 {dict merge command} {
- getOrder [dict merge {a b c d} {a x c y}] a c
-} {a x c y 2}
+ dict merge {a b c d} {c y a x}
+} {a x c y}
test dict-20.10 {dict merge command} {
- getOrder [dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}] a c e 1 3
-} {a - c d e f 1 - 3 4 5}
+ 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.11 {dict merge command} {
+ apply {{} {dict merge}}
+} {}
+test dict-20.12 {dict merge command} {
+ apply {{} {dict merge {a b c d e f}}}
+} {a b c d e f}
+test dict-20.13 {dict merge command} -body {
+ apply {{} {dict merge {a b c d e}}}
+} -result {missing value to go with key} -returnCodes error
+test dict-20.14 {dict merge command} {
+ apply {{} {dict merge {a b c d} {e f g h}}}
+} {a b c d e f g h}
+test dict-20.15 {dict merge command} -body {
+ apply {{} {dict merge {a b c d e} {e f g h}}}
+} -result {missing value to go with key} -returnCodes error
+test dict-20.16 {dict merge command} -body {
+ apply {{} {dict merge {a b c d} {e f g h i}}}
+} -result {missing value to go with key} -returnCodes error
+test dict-20.17 {dict merge command} {
+ apply {{} {dict merge {a b c d e f} {e x g h}}}
+} {a b c d e x g h}
+test dict-20.18 {dict merge command} {
+ apply {{} {dict merge {a b c d} {a x c y}}}
+} {a x c y}
+test dict-20.19 {dict merge command} {
+ apply {{} {dict merge {a b c d} {c y a x}}}
+} {a x c y}
+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 {dict element in braces followed by "c" instead of space}
-test dict-21.1 {dict update command} -body {
+test dict-21.1 {dict update command} -returnCodes 1 -body {
dict update
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.2 {dict update command} -body {
+} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
+test dict-21.2 {dict update command} -returnCodes 1 -body {
dict update v
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.3 {dict update command} -body {
+} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
+test dict-21.3 {dict update command} -returnCodes 1 -body {
dict update v k
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.4 {dict update command} -body {
+} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
+test dict-21.4 {dict update command} -returnCodes 1 -body {
dict update v k v
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.5 {dict update command} {
+} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
+test dict-21.5 {dict update command} -body {
set a {b c}
set result {}
set bb {}
@@ -999,8 +1326,10 @@ test dict-21.5 {dict update command} {
lappend result $a $bb
}
lappend result $a
-} {{b c} c {b c}}
-test dict-21.6 {dict update command} {
+} -cleanup {
+ unset a result bb
+} -result {{b c} c {b c}}
+test dict-21.6 {dict update command} -body {
set a {b c}
set result {}
set bb {}
@@ -1008,8 +1337,10 @@ test dict-21.6 {dict update command} {
lappend result $a $bb [set bb d]
}
lappend result $a
-} {{b c} c d {b d}}
-test dict-21.7 {dict update command} {
+} -cleanup {
+ unset a result bb
+} -result {{b c} c d {b d}}
+test dict-21.7 {dict update command} -body {
set a {b c}
set result {}
set bb {}
@@ -1017,44 +1348,56 @@ test dict-21.7 {dict update command} {
lappend result $a $bb [unset bb]
}
lappend result $a
-} {{b c} c {} {}}
-test dict-21.8 {dict update command} {
+} -cleanup {
+ unset a result
+} -result {{b c} c {} {}}
+test dict-21.8 {dict update command} -body {
set a {b c d e}
dict update a b v1 d v2 {
lassign "$v1 $v2" v2 v1
}
- getOrder $a b d
-} {b e d c 2}
-test dict-21.9 {dict update command} {
+ return $a
+} -cleanup {
+ unset a v1 v2
+} -result {b e d c}
+test dict-21.9 {dict update command} -body {
set a {b c d e}
dict update a b v1 d v2 {unset a}
info exist a
-} 0
-test dict-21.10 {dict update command} {
+} -cleanup {
+ unset v1 v2
+} -result 0
+test dict-21.10 {dict update command} -body {
set a {b {c d}}
dict update a b v1 {
dict update v1 c v2 {
set v2 foo
}
}
- set a
-} {b {c foo}}
-test dict-21.11 {dict update command} {
+ return $a
+} -cleanup {
+ unset a v1 v2
+} -result {b {c foo}}
+test dict-21.11 {dict update command} -body {
set a {b c d e}
dict update a b v1 d v2 {
dict set a f g
}
- getOrder $a b d f
-} {b c d e f g 3}
-test dict-21.12 {dict update command} {
+ return $a
+} -cleanup {
+ unset a v1 v2
+} -result {b c d e f g}
+test dict-21.12 {dict update command} -body {
set a {b c d e}
dict update a b v1 d v2 f v3 {
set v3 g
}
- getOrder $a b d f
-} {b c d e f g 3}
+ return $a
+} -cleanup {
+ unset a v1 v2 v3
+} -result {b c d e f g}
test dict-21.13 {dict update command: compilation} {
- proc dicttest {d} {
+ apply {d {
while 1 {
dict update d a alpha b beta {
set beta $alpha
@@ -1063,26 +1406,23 @@ test dict-21.13 {dict update command: compilation} {
}
}
return $d
- }
- getOrder [dicttest {a 1 c 2}] b c
-} {b 1 c 2 2}
+ }} {a 1 c 2}
+} {c 2 b 1}
test dict-21.14 {dict update command: compilation} {
- proc dicttest x {
+ apply {x {
set indices {2 3}
trace add variable aa write "string length \$indices ;#"
dict update x k aa l bb {}
- }
- dicttest {k 1 l 2}
+ }} {k 1 l 2}
} {}
test dict-21.15 {dict update command: compilation} {
- proc dicttest x {
+ apply {x {
set indices {2 3}
trace add variable aa read "string length \$indices ;#"
dict update x k aa l bb {}
- }
- dicttest {k 1 l 2}
+ }} {k 1 l 2}
} {}
-test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} {
+test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} -body {
set foo {a {b {c {d {e 1}}}}}
dict update foo a t {
dict update t b t {
@@ -1094,9 +1434,11 @@ test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} {
}
}
string range [append foo OK] end-1 end
-} OK
+} -cleanup {
+ unset foo t
+} -result OK
test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} {
- proc dicttest {} {
+ apply {{} {
set foo {a {b {c {d {e 1}}}}}
dict update foo a t {
dict update t b t {
@@ -1107,68 +1449,79 @@ test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} {
}
}
}
- }
- dicttest
- string range [append foo OK] end-1 end
+ string range [append foo OK] end-1 end
+ }}
} OK
test dict-22.1 {dict with command} -body {
dict with
-} -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?key ...? script"}
+} -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"}
test dict-22.2 {dict with command} -body {
dict with v
-} -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?key ...? script"}
+} -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"}
test dict-22.3 {dict with command} -body {
unset -nocomplain v
dict with v {error "in body"}
} -returnCodes 1 -result {can't read "v": no such variable}
-test dict-22.4 {dict with command} {
+test dict-22.4 {dict with command} -body {
set a {b c d e}
unset -nocomplain b d
set result [list [info exist b] [info exist d]]
dict with a {
lappend result [info exist b] [info exist d] $b $d
}
- set result
-} {0 0 1 1 c e}
-test dict-22.5 {dict with command} {
+ return $result
+} -cleanup {
+ unset a b d result
+} -result {0 0 1 1 c e}
+test dict-22.5 {dict with command} -body {
set a {b c d e}
dict with a {
lassign "$b $d" d b
}
- getOrder $a b d
-} {b e d c 2}
-test dict-22.6 {dict with command} {
+ return $a
+} -cleanup {
+ unset a b d
+} -result {b e d c}
+test dict-22.6 {dict with command} -body {
set a {b c d e}
dict with a {
unset b
# This *won't* go into the dict...
set f g
}
- set a
-} {d e}
-test dict-22.7 {dict with command} {
+ return $a
+} -cleanup {
+ unset a d f
+} -result {d e}
+test dict-22.7 {dict with command} -body {
set a {b c d e}
dict with a {
dict unset a b
}
- getOrder $a b d
-} {b c d e 2}
-test dict-22.8 {dict with command} {
+ return $a
+} -cleanup {
+ unset a
+} -result {d e b c}
+test dict-22.8 {dict with command} -body {
set a [dict create b c]
dict with a {
set b $a
}
- set a
-} {b {b c}}
-test dict-22.9 {dict with command} {
+ return $a
+} -cleanup {
+ unset a b
+} -result {b {b c}}
+test dict-22.9 {dict with command} -body {
set a {b {c d}}
dict with a b {
set c $c$c
}
- set a
-} {b {c dd}}
-test dict-22.10 {dict with command: result handling tricky case} {
+ return $a
+} -cleanup {
+ unset a c
+} -result {b {c dd}}
+test dict-22.10 {dict with command: result handling tricky case} -body {
set a {b {c d}}
foreach i {0 1} {
if {$i} break
@@ -1179,8 +1532,10 @@ test dict-22.10 {dict with command: result handling tricky case} {
}
}
list $i $a
-} {0 {}}
-test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} {
+} -cleanup {
+ unset a i c
+} -result {0 {}}
+test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} -body {
set foo {t {t {t {inner 1}}}}
dict with foo {
dict with t {
@@ -1192,13 +1547,129 @@ test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} {
}
}
string range [append foo OK] end-1 end
-} OK
+} -cleanup {
+ unset foo t inner
+} -result OK
+test dict-22.12 {dict with: compiled} {
+ apply {{} {
+ set d {a 1 b 2}
+ list [dict with d {
+ set a $b
+ unset b
+ dict set d c 3
+ list ok
+ }] $d
+ }}
+} {ok {a 2 c 3}}
+test dict-22.13 {dict with: compiled} {
+ apply {i {
+ set d($i) {a 1 b 2}
+ list [dict with d($i) {
+ set a $b
+ unset b
+ dict set d($i) c 3
+ list ok
+ }] [array get d]
+ }} e
+} {ok {e {a 2 c 3}}}
+test dict-22.14 {dict with: compiled} {
+ apply {{} {
+ set d {a 1 b 2}
+ foreach x {1 2 3} {
+ dict with d {
+ incr a $b
+ if {$x == 2} break
+ }
+ unset a b
+ }
+ list $a $b $x $d
+ }}
+} {5 2 2 {a 5 b 2}}
+test dict-22.15 {dict with: compiled} {
+ apply {i {
+ set d($i) {a 1 b 2}
+ foreach x {1 2 3} {
+ dict with d($i) {
+ incr a $b
+ if {$x == 2} break
+ }
+ unset a b
+ }
+ list $a $b $x [array get d]
+ }} e
+} {5 2 2 {e {a 5 b 2}}}
+test dict-22.16 {dict with: compiled} {
+ apply {{} {
+ set d {p {q {a 1 b 2}}}
+ dict with d p q {
+ set a $b.$a
+ }
+ return $d
+ }}
+} {p {q {a 2.1 b 2}}}
+test dict-22.17 {dict with: compiled} {
+ apply {i {
+ set d($i) {p {q {a 1 b 2}}}
+ dict with d($i) p q {
+ set a $b.$a
+ }
+ array get d
+ }} e
+} {e {p {q {a 2.1 b 2}}}}
+test dict-22.18 {dict with: compiled} {
+ set ::d {a 1 b 2}
+ apply {{} {
+ dict with ::d {
+ set a $b.$a
+ }
+ return $::d
+ }}
+} {a 2.1 b 2}
+test dict-22.19 {dict with: compiled} {
+ set ::d {p {q {r {a 1 b 2}}}}
+ apply {{} {
+ dict with ::d p q r {
+ set a $b.$a
+ }
+ return $::d
+ }}
+} {p {q {r {a 2.1 b 2}}}}
+test dict-22.20 {dict with: compiled} {
+ apply {d {
+ dict with d {
+ }
+ return $a,$b
+ }} {a 1 b 2}
+} 1,2
+test dict-22.21 {dict with: compiled} {
+ apply {d {
+ dict with d p q {
+ }
+ return $a,$b
+ }} {p {q {a 1 b 2}}}
+} 1,2
+test dict-22.22 {dict with: compiled} {
+ set ::d {a 1 b 2}
+ apply {{} {
+ dict with ::d {
+ }
+ return $a,$b
+ }}
+} 1,2
+test dict-22.23 {dict with: compiled} {
+ set ::d {p {q {a 1 b 2}}}
+ apply {{} {
+ dict with ::d p q {
+ }
+ return $a,$b
+ }}
+} 1,2
proc linenumber {} {
dict get [info frame -1] line
}
test dict-23.1 {dict compilation crash: Bug 3487626} {
- apply {n {
+ apply {{} {apply {n {
set e {}
set k {}
dict for {a b} {c {d {e {f g}}}} {
@@ -1210,14 +1681,14 @@ test dict-23.1 {dict compilation crash: Bug 3487626} {
}
}
}
- }} [linenumber]
+ }} [linenumber]}}
} 5
test dict-23.2 {dict compilation crash: Bug 3487626} {
# Something isn't quite right in line number and continuation line
# tracking; at time of writing, this test produces 7, not 5, which
# indicates that the extra newlines in the non-script argument are
# confusing things.
- apply {n {
+ apply {{} {apply {n {
set e {}
set k {}
dict for {a {
@@ -1241,7 +1712,237 @@ j
}
}
}
- }} [linenumber]
+ }} [linenumber]}}
+} 5
+rename linenumber {}
+
+test dict-24.1 {dict map command: syntax} -returnCodes error -body {
+ dict map
+} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
+test dict-24.2 {dict map command: syntax} -returnCodes error -body {
+ dict map x
+} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
+test dict-24.3 {dict map command: syntax} -returnCodes error -body {
+ dict map x x
+} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
+test dict-24.4 {dict map command: syntax} -returnCodes error -body {
+ dict map x x x x
+} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
+test dict-24.5 {dict map command: syntax} -returnCodes error -body {
+ dict map x x x
+} -result {must have exactly two variable names}
+test dict-24.6 {dict map command: syntax} -returnCodes error -body {
+ dict map {x x x} x x
+} -result {must have exactly two variable names}
+test dict-24.7 {dict map command: syntax} -returnCodes error -body {
+ dict map "\{x" x x
+} -result {unmatched open brace in list}
+test dict-24.8 {dict map command} -setup {
+ set values {}
+ set keys {}
+} -body {
+ # This test confirms that [dict keys], [dict values] and [dict map]
+ # all traverse a dictionary in the same order.
+ set dictv {a A b B c C}
+ dict map {k v} $dictv {
+ lappend keys $k
+ lappend values $v
+ }
+ set result [expr {
+ $keys eq [dict keys $dictv] && $values eq [dict values $dictv]
+ }]
+ expr {$result ? "YES" : [list "NO" $dictv $keys $values]}
+} -cleanup {
+ unset result keys values k v dictv
+} -result YES
+test dict-24.9 {dict map command} {
+ dict map {k v} {} {
+ error "unexpected execution of 'dict map' body"
+ }
+} {}
+test dict-24.10 {dict map command: script results} -body {
+ set times 0
+ dict map {k v} {a a b b} {
+ incr times
+ continue
+ error "shouldn't get here"
+ }
+ return $times
+} -cleanup {
+ unset times k v
+} -result 2
+test dict-24.11 {dict map command: script results} -body {
+ set times 0
+ dict map {k v} {a a b b} {
+ incr times
+ break
+ error "shouldn't get here"
+ }
+ return $times
+} -cleanup {
+ unset times k v
+} -result 1
+test dict-24.12 {dict map command: script results} -body {
+ set times 0
+ list [catch {
+ dict map {k v} {a a b b} {
+ incr times
+ error test
+ }
+ } msg] $msg $times $::errorInfo
+} -cleanup {
+ unset times k v msg
+} -result {1 test 1 {test
+ while executing
+"error test"
+ ("dict map" body line 3)
+ invoked from within
+"dict map {k v} {a a b b} {
+ incr times
+ error test
+ }"}}
+test dict-24.13 {dict map command: script results} {
+ apply {{} {
+ dict map {k v} {a b} {
+ return ok,$k,$v
+ error "skipped return completely"
+ }
+ error "return didn't go far enough"
+ }}
+} ok,a,b
+test dict-24.14 {dict map command: handle representation loss} -setup {
+ set keys {}
+ set values {}
+} -body {
+ set dictVar {a b c d e f g h}
+ list [dict size [dict map {k v} $dictVar {
+ if {[llength $dictVar]} {
+ lappend keys $k
+ lappend values $v
+ return -level 0 $k
+ }
+ }]] [lsort $keys] [lsort $values]
+} -cleanup {
+ unset dictVar keys values k v
+} -result {4 {a c e g} {b d f h}}
+test dict-24.14a {dict map command: handle representation loss} -body {
+ apply {{} {
+ set dictVar {a b c d e f g h}
+ list [dict size [dict map {k v} $dictVar {
+ if {[llength $dictVar]} {
+ lappend keys $k
+ lappend values $v
+ return -level 0 $k
+ }
+ }]] [lsort $keys] [lsort $values]
+ }}
+} -result {4 {a c e g} {b d f h}}
+test dict-24.15 {dict map command: keys are unique and iterated over once only} -setup {
+ unset -nocomplain accum
+ array set accum {}
+} -body {
+ set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+ dict map {k v} $dictVar {
+ append accum($k) $v,
+ }
+ set result [lsort [array names accum]]
+ lappend result :
+ foreach k $result {
+ catch {lappend result $accum($k)}
+ }
+ return $result
+} -cleanup {
+ unset dictVar k v result accum
+} -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
+test dict-24.16 {dict map command in compilation context} {
+ apply {{} {
+ set res {x x x x x x}
+ dict map {k v} {a 0 b 1 c 2 d 3 e 4 f 5} {
+ lset res $v $k
+ continue
+ }
+ return $res
+ }}
+} {a b c d e f}
+test dict-24.17 {dict map command in compilation context} {
+ # Bug 1379349 (dict for)
+ apply {{} {
+ set d [dict create a 1] ;# Dict must be unshared!
+ dict map {k v} $d {
+ dict set d $k 0 ;# Any modification will do
+ }
+ return $d
+ }}
+} {a 0}
+test dict-24.17a {dict map command in compilation context} {
+ # Bug 1379349 (dict for)
+ apply {{} {
+ set d [dict create a 1] ;# Dict must be unshared!
+ dict map {k v} $d {
+ dict set d $k 0 ;# Any modification will do
+ }
+ }}
+} {a {a 0}}
+test dict-24.18 {dict map command in compilation context} {
+ # Bug 1382528 (dict for)
+ apply {{} {
+ dict map {k v} {} {} ;# Note empty dict
+ catch { error foo } ;# Note compiled [catch]
+ }}
+} 1
+test dict-24.19 {dict map and invalid dicts: 'dict for' bug 1531184} -body {
+ di[list]ct map {k v} x {}
+} -returnCodes 1 -result {missing value to go with key}
+test dict-24.20 {dict map stack space compilation: 'dict for' bug 1903325} {
+ apply {{x y args} {
+ dict map {a b} $x {}
+ concat "c=$y,$args"
+ }} {} 1 2 3
+} {c=1,2 3}
+proc linenumber {} {
+ dict get [info frame -1] line
+}
+test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} {
+ apply {{} {apply {n {
+ set e {}
+ set k {}
+ dict map {a b} {c {d {e {f g}}}} {
+ ::tcl::dict::map {h i} $b {
+ dict update i e j {
+ ::tcl::dict::update j f k {
+ return [expr {$n - [linenumber]}]
+ }
+ }
+ }
+ }
+ }} [linenumber]}}
+} 5
+test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} {
+ apply {{} {apply {n {
+ set e {}
+ set k {}
+ dict map {a {
+b
+}} {c {d {e {f g}}}} {
+ ::tcl::dict::map {h {
+i
+}} ${
+b
+} {
+ dict update {
+i
+} e {
+j
+} {
+ ::tcl::dict::update {
+j
+} f k {
+ return [expr {$n - [linenumber]}]
+ }
+ }
+ }
+ }
+ }} [linenumber]}}
} 5
test dict-23.3 {CompileWord OBOE} {
# segfault when buggy
@@ -1277,9 +1978,77 @@ test dict-23.8 {CompileWord OBOE} {
} [return [incr n -[linenumber]]] x {}
}} [linenumber]
} 1
+test dict-23.9 {CompileWord OBOE} {
+ apply {n {
+ dict exists {} {*}{
+ } [return [incr n -[linenumber]]]
+ }} [linenumber]
+} 1
+test dict-23.10 {CompileWord OBOE} {
+ apply {n {
+ dict with foo {*}{
+ } [return [incr n -[linenumber]]] {}
+ }} [linenumber]
+} 1
+test dict-23.11 {CompileWord OBOE} {
+ apply {n {
+ dict with ::foo {*}{
+ } [return [incr n -[linenumber]]] {}
+ }} [linenumber]
+} 1
+test dict-23.12 {CompileWord OBOE} {
+ apply {n {
+ dict with {*}{
+ } [return [incr n -[linenumber]]] {}
+ }} [linenumber]
+} 1
+test dict-23.13 {CompileWord OBOE} {
+ apply {n {
+ dict with {*}{
+ } [return [incr n -[linenumber]]] {bar}
+ }} [linenumber]
+} 1
+test dict-23.14 {CompileWord OBOE} {
+ apply {n {
+ dict with foo {*}{
+ } [return [incr n -[linenumber]]] {bar}
+ }} [linenumber]
+} 1
rename linenumber {}
+test dict-24.22 {dict map results (non-compiled)} {
+ dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
+ return -level 0 "$k,$v"
+ }
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
+test dict-24.23 {dict map results (compiled)} {
+ apply {{} {
+ dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
+ return -level 0 "$k,$v"
+ }
+ }}
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
+test dict-24.23a {dict map results (compiled)} {
+ apply {{list} {
+ dict map {k v} [dict map {k v} $list { list $v $k }] {
+ return -level 0 "$k,$v"
+ }
+ }} {a 1 b 2 c 3 d 4}
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
+test dict-24.24 {dict map with huge dict (non-compiled)} {
+ tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat 100000 x] x] {
+ expr { $k * $v }
+ }]
+} 166666666600000
+test dict-24.25 {dict map with huge dict (compiled)} {
+ apply {{n} {
+ tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat $n y] y] {
+ expr { $k * $v }
+ }]
+ }} 100000
+} 166666666600000
+
# cleanup
::tcltest::cleanupTests
return