diff options
author | Steve Bennett <steveb@workware.net.au> | 2011-12-12 10:43:33 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2013-12-21 01:56:58 +1000 |
commit | 5390d57487b0bc2cd6ff736f50e0acbbdb6c03e7 (patch) | |
tree | 79c84a1accd358ca851081c76e5c7b3b3b12dda8 /tests/dict2.test | |
parent | d30e9aabf9e5e1956f25a3f74f61d26075a39c46 (diff) | |
download | jimtcl-5390d57487b0bc2cd6ff736f50e0acbbdb6c03e7.zip jimtcl-5390d57487b0bc2cd6ff736f50e0acbbdb6c03e7.tar.gz jimtcl-5390d57487b0bc2cd6ff736f50e0acbbdb6c03e7.tar.bz2 |
Implement more dict sub commands
dict for, values, incr, append, lappend, update, replace and info
Also implement array stat (the same as dict info)
Note that [dict info] and [array stat] are for useful for checking
the behaviour of the hash randomiser
Add Jim_EvalEnsemble()
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'tests/dict2.test')
-rw-r--r-- | tests/dict2.test | 1249 |
1 files changed, 1249 insertions, 0 deletions
diff --git a/tests/dict2.test b/tests/dict2.test new file mode 100644 index 0000000..01826dc --- /dev/null +++ b/tests/dict2.test @@ -0,0 +1,1249 @@ +# 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. +# +# 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. + +source [file dirname [info script]]/testing.tcl + +# jim dicts don't preserve order, so always sort +# before checking results +proc dict-sort {dict} { + set result {} + foreach k [lsort [dict keys $dict]] { + lappend result $k [dict get $dict $k] + } + return $result +} + +test dict-1.1 {dict command basic syntax} -returnCodes error -body { + dict +} -match glob -result {wrong # args: should be "dict subcommand ?arg* ...?"} +test dict-1.2 {dict command basic syntax} -returnCodes error -body { + dict ? +} -match glob -result * + +test dict-2.1 {dict create command} { + dict create +} {} +test dict-2.2 {dict create command} { + dict create a b +} {a b} +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 + foreach key {a c} { + set idx [lsearch -exact $dict $key] + if {$idx & 1} { + error "found $key at odd index $idx in $dict" + } + lappend result [lindex $dict [expr {$idx+1}]] + } + 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] + if {[catch { + set share [dict values $dictv] + }]} { + set share [array get 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-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} -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} -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} -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"} { + return OK + } elseif {$dict eq "c d a b"} { + return reordered + } else { + return $dict + } +} -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 { + proc x {} { + dict set a(z) b c + dict get $a(z) d + } + x +} -returnCodes error -result {key "d" not known in dictionary} +test dict-3.16 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;set l} {p 1 p 2 q 3} +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} { + dict replace {a b c d} +} {a b c d} +test dict-4.2 {dict replace command} { + dict-sort [dict replace {a b c d} e f] +} {a b c d e f} +test dict-4.3 {dict replace command} { + dict-sort [dict replace {a b c d} c f] +} {a b c f} +test dict-4.4 {dict replace command} { + dict-sort [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-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} { + 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} -returnCodes error -body { + dict remove +} -result {wrong # args: should be "dict remove dictionary ?key ...?"} + +test dict-6.1 {dict keys command} {dict keys {a b}} a +test dict-6.2 {dict keys command} {dict keys {c d}} c +test dict-6.3 {dict keys command} {lsort [dict keys {a b c d}]} {a c} +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} -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 +test dict-7.3 {dict values command} {lsort [dict values {a b c d}]} {b d} +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} -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} -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 +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} -returnCodes error -body { + dict exists {a {b c d}} a c +} -result {missing value to go with 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} -body { +# # Actual string returned by this command is undefined; it is +# # intended for human consumption and not for use by scripts. +# dict info {} +#} -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} -body { + set dictv [dict create \ + a [string index "=0=" 1] \ + b [expr {1+2}] \ + c [expr {0x80000000+1}]] + dict incr dictv a + dict-sort $dictv +} -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 {0x80000000+1}]] + dict incr dictv b + dict-sort $dictv +} -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 {0x80000000+1}]] + dict incr dictv c + dict-sort $dictv +} -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 {0x80000000+1}]] + set sharing [dict values $dictv] + dict incr dictv a + dict-sort $dictv +} -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 {0x80000000+1}]] + set sharing [dict values $dictv] + dict incr dictv b + dict-sort $dictv +} -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 {0x80000000+1}]] + set sharing [dict values $dictv] + dict incr dictv c + dict-sort $dictv +} -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 {0x80000000+1}]] + dict incr dictv d + dict-sort $dictv +} -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 + dict-sort $dictv +} -cleanup { + unset dictv +} -result {a 3} +test dict-11.9 {dict incr command} -returnCodes error -body { + set dictv {a dummy} + dict incr dictv a + dict-sort $dictv +} -cleanup { + unset dictv +} -result {expected integer but got "dummy"} +test dict-11.10 {dict incr command} -returnCodes error -body { + set dictv {a 1} + dict incr dictv a dummy + dict-sort $dictv +} -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 + dict-sort $dictv +} -cleanup { + unset dictv +} -result {a 1} +test dict-11.12 {dict incr command} -returnCodes error -body { + set dictv a + dict incr dictv a + dict-sort $dictv +} -cleanup { + unset dictv +} -result {missing value to go with key} +test dict-11.13 {dict incr command} -returnCodes error -body { + set dictv a + dict incr dictv a a a + dict-sort $dictv +} -cleanup { + unset dictv +} -result {wrong # args: should be "dict incr varName key ?increment?"} +test dict-11.14 {dict incr command} -returnCodes error -body { + set dictv a + dict incr dictv + dict-sort $dictv +} -cleanup { + unset dictv +} -result {wrong # args: should be "dict incr varName key ?increment?"} +test dict-11.15 {dict incr command: write failure} -setup { + unset -nocomplain dictVar +} -body { + set dictVar 1 + dict incr dictVar a + dict-sort $dictv +} -returnCodes error -cleanup { + unset dictVar +} -result {missing value to go with key} +test dict-11.16 {dict incr command: compilation} { + 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] + }} +} {1 1 2 3} +test dict-11.17 {dict incr command: compilation} { + apply {{} { + set dictv {a 1} + dict incr dictv a 2 + dict-sort $dictv + }} +} {a 3} + +test dict-12.1 {dict lappend command} -body { + set dictv {a a} + dict lappend dictv a +} -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 + dict-sort $dictv +} -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 + dict-sort $dictv +} -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 + dict-sort $dictv +} -cleanup { + unset dictv +} -result {a {a b}} +test dict-12.4 {dict lappend command} -body { + set dictv {} + dict lappend dictv a x y z + dict-sort $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 + dict-sort $dictv +} -cleanup { + unset dictv +} -result {a b} +test dict-12.6 {dict lappend command} -returnCodes error -body { + set dictv a + dict lappend dictv a a + dict-sort $dictv +} -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 varName key ?value ...?"} +test dict-12.8 {dict lappend command} -returnCodes error -body { + dict lappend dictv +} -result {wrong # args: should be "dict lappend varName key ?value ...?"} +test dict-12.9 {dict lappend command} -returnCodes error -constraints tcl -body { + set dictv [dict create a "\{"] + 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 1 + dict lappend dictVar a x +} -returnCodes error -cleanup { + unset dictVar +} -result {missing value to go with key} +test dict-12.11 {compiled dict append: invalidate string rep - Bug 3079830} { + dict-sort [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} -body { + set dictv {a a} + dict append dictv a +} -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 +} -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 +} -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 +} -cleanup { + unset dictv +} -result {a ab} +test dict-13.4 {dict append command} -body { + set dictv {} + dict append dictv a x y z +} -cleanup { + unset dictv +} -result {a xyz} +test dict-13.5 {dict append command} -body { + unset -nocomplain dictv + dict append dictv a b +} -cleanup { + unset dictv +} -result {a b} +test dict-13.6 {dict append command} -returnCodes error -body { + set dictv a + 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 varName key ?value ...?"} +test dict-13.8 {dict append command} -returnCodes error -body { + dict append dictv +} -result {wrong # args: should be "dict append varName key ?value ...?"} +test dict-13.9 {dict append command: write failure} -setup { + unset -nocomplain dictVar +} -body { + set dictVar 1 + dict append dictVar a x +} -returnCodes error -cleanup { + unset dictVar +} -result {missing value to go with key} +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} { + dict-sort [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} -returnCodes error -body { + dict for +} -match glob -result {wrong # args: should be *} +test dict-14.2 {dict for command: syntax} -returnCodes error -body { + dict for x +} -match glob -result {wrong # args: should be *} +test dict-14.3 {dict for command: syntax} -returnCodes error -body { + dict for x x +} -match glob -result {wrong # args: should be *} +test dict-14.4 {dict for command: syntax} -returnCodes error -body { + dict for x x x x +} -match glob -result {wrong # args: should be *} +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 -constraints tcl -body { + dict for "\{x" x x +} -result {unmatched open brace in list} +test dict-14.8 {dict for command} -constraints tcl -body { + # This test confirms that [dict keys], [dict values] and [dict for] + # all traverse a dictionary in the same order. + # Note that Jim Tcl does *not* preserver order + set dictv {a A b B c C} + set keys {} + set values {} + dict for {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-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} -body { + set times 0 + dict for {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-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" + } + 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} { + incr times + error test + } + } msg] $msg $times +} -cleanup { + unset times k v msg +} -result {1 test 1} +test dict-14.13 {dict for command: script results} { + apply {{} { + dict for {k v} {a b} { + return ok,$k,$v + error "skipped return completely" + } + error "return didn't go far enough" + }} +} ok,a,b +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 {} + dict for {k v} $dictVar { + if {[llength $dictVar]} { + lappend keys $k + lappend values $v + } + } + list [lsort $keys] [lsort $values] +} -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, + } + 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-14.16 {dict for command in compilation context} { + 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 + }} +} {a b c d e f} +test dict-14.17 {dict for command in compilation context} { + # Bug 1379349 + 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 + }} +} {a 0} +test dict-14.18 {dict for command in compilation context} { + # Bug 1382528 + apply {{} { + dict for {k v} {} {} ;# Note empty dict + catch { error foo } ;# Note compiled [catch] + }} +} 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} { + apply {{x y args} { + dict for {a b} $x {} + concat "c=$y,$args" + }} {} 1 2 3 +} {c=1,2 3} +# 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} -body { + set dictVar {} + dict set dictVar a x +} -cleanup { + unset dictVar +} -result {a x} +test dict-15.2 {dict set command} -body { + set dictvar {a {}} + dict set dictvar a b x +} -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 +} -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 +} -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 +} -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 +} -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 +} -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 + return $dictVar +} -cleanup { + unset dictVar +} -result {a x} +test dict-15.9 {dict set command: write failure} -setup { + unset -nocomplain dictVar +} -body { + set dictVar 1 + dict set dictVar a x +} -returnCodes error -cleanup { + unset dictVar +} -result {missing value to go with key} +test dict-15.10 {dict set command: syntax} -returnCodes error -body { + dict set +} -result {wrong # args: should be "dict set varName key ?key ...? value"} +test dict-15.11 {dict set command: syntax} -returnCodes error -body { + dict set a +} -result {wrong # args: should be "dict set varName 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 varName key ?key ...? value"} +test dict-15.13 {dict set command} -returnCodes error -body { + set dictVar a + dict set dictVar b c +} -cleanup { + unset dictVar +} -result {missing value to go with key} + +test dict-16.1 {dict unset command} -body { + set dictVar {a b c d} + dict unset dictVar a +} -cleanup { + unset dictVar +} -result {c d} +test dict-16.2 {dict unset command} -body { + set dictVar {a b c d} + dict unset dictVar c +} -cleanup { + unset dictVar +} -result {a b} +test dict-16.3 {dict unset command} -body { + set dictVar {a b} + dict unset dictVar c +} -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 +} -cleanup { + unset dictVar +} -result {a {d e}} +test dict-16.5 {dict unset command} -returnCodes error -body { + set dictVar a + 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} + 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] +} -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 varName key ?key ...?"} +test dict-16.9 {dict unset command: write failure} -setup { + unset -nocomplain dictVar +} -body { + set dictVar 1 + dict unset dictVar a +} -returnCodes error -cleanup { + unset dictVar +} -result {missing value to go with 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 +#} -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 *] +#} -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} +# 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 +#} -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 *] +#} -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} +# 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 [dict filter $dictVar script {k v} { +# incr n +# expr {[string length $k] == [string length $v]} +# }] $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 +#} -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} -setup { +# set n 0 +#} -body { +# list [dict filter {a b c d} script {k v} { +# incr n +# break +# error boom! +# }] $n +#} -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 +#} -cleanup { +# unset n k v +#} -result {{} 2} +#test dict-17.16 {dict filter command: script} { +# apply {{} { +# dict filter {a b} script {k v} { +# return ok,$k,$v +# error "skipped return completely" +# } +# error "return didn't go far enough" +# }} +#} ok,a,b +#test dict-17.17 {dict filter command: script} -body { +# dict filter {a b} script {k k} {continue} +# 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 {keyVar valueVar} 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 + 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 + } + 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} + +test dict-20.1 {dict merge command} { + dict merge +} {} +test dict-20.2 {dict merge command} { + dict-sort [dict merge {a b c d e f}] +} {a b c d e f} +test dict-20.3 {dict merge command} -body { + dict-sort [dict merge {a b c d e}] +} -result {missing value to go with key} -returnCodes error +test dict-20.4 {dict merge command} { + dict-sort [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-sort [dict merge {a b c d e} {e f g h}] +} -result {missing value to go with key} -returnCodes error +test dict-20.6 {dict merge command} -body { + dict-sort [dict merge {a b c d} {e f g h i}] +} -result {missing value to go with key} -returnCodes error +test dict-20.7 {dict merge command} { + dict-sort [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} { + dict-sort [dict merge {a b c d} {a x c y}] +} {a x c y} +test dict-20.9 {dict merge command} { + dict-sort [dict merge {a b c d} {c y a x}] +} {a x c y} +test dict-20.10 {dict merge command} { + dict-sort [dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}] +} {1 - 3 4 a - c d e f} + +test dict-21.1 {dict update command} -returnCodes 1 -body { + dict update +} -match glob -result {wrong # args: should be "dict update varName * script"} +test dict-21.2 {dict update command} -returnCodes 1 -body { + dict update v +} -match glob -result {wrong # args: should be "dict update varName * script"} +test dict-21.3 {dict update command} -returnCodes 1 -body { + dict update v k +} -match glob -result {wrong # args: should be "dict update varName * script"} +test dict-21.4 {dict update command} -returnCodes 1 -body { + dict update v k v +} -match glob -result {wrong # args: should be "dict update varName * script"} +test dict-21.5 {dict update command} -body { + set a {b c} + set result {} + set bb {} + dict update a b bb { + lappend result $a $bb + } + lappend result $a +} -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 {} + dict update a b bb { + lappend result $a $bb [set bb d] + } + lappend result $a +} -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 {} + dict update a b bb { + lappend result $a $bb [unset bb] + } + lappend result $a +} -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 + } + dict-sort $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 +} -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 + } + } + dict-sort $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 + } + dict-sort $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 + } + dict-sort $a +} -cleanup { + unset a v1 v2 v3 +} -result {b c d e f g} +test dict-21.13 {dict update command: compilation} { + apply {d { + while 1 { + dict update d a alpha b beta { + set beta $alpha + unset alpha + break + } + } + dict-sort $d + }} {a 1 c 2} +} {b 1 c 2} +test dict-21.14 {dict update command: compilation} tcl { + apply {x { + set indices {2 3} + trace add variable aa write "string length \$indices ;#" + dict update x k aa l bb {} + }} {k 1 l 2} +} {} +test dict-21.15 {dict update command: compilation} tcl { + apply {x { + set indices {2 3} + trace add variable aa read "string length \$indices ;#" + dict update x k aa l bb {} + }} {k 1 l 2} +} {} +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 { + dict update t c t { + dict update t d t { + dict incr t e + } + } + } + } + string range [append foo OK] end-1 end +} -cleanup { + unset foo t +} -result OK +test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} { + apply {{} { + set foo {a {b {c {d {e 1}}}}} + dict update foo a t { + dict update t b t { + dict update t c t { + dict update t d t { + dict incr t e + } + } + } + } + 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"} +test dict-22.2 {dict with command} -body { + dict with v +} -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?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} -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 + } + 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 + } + dict-sort $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 + } + 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 + } + return [dict-sort $a] +} -cleanup { + unset a +} -result {b c d e} +test dict-22.8 {dict with command} -body { + set a [dict create b c] + dict with a { + set b $a + } + 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 + } + 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 + dict with a b { + set a {} + # We're checking to see if we lose this break + break + } + } + list $i $a +} -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 { + dict with t { + dict with t { + incr inner + } + } + } + } + string range [append foo OK] end-1 end +} -cleanup { + unset foo t inner +} -result OK + +testreport |