diff options
Diffstat (limited to 'tests/dict.test')
| -rw-r--r-- | tests/dict.test | 2045 |
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 |