diff options
| -rw-r--r-- | tests/dict.test | 749 |
1 files changed, 369 insertions, 380 deletions
diff --git a/tests/dict.test b/tests/dict.test index fd33ab0..3917404 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: dict.test,v 1.26 2008/05/07 10:42:14 dkf Exp $ +# RCS: @(#) $Id: dict.test,v 1.27 2008/05/07 13:17:49 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -33,12 +33,12 @@ proc getOrder {dictVal args} { 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 ?argument ...?"} +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 @@ -59,12 +59,12 @@ test dict-2.3 {dict create command} { } 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.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!} { # Bug 715751 will show up in memory debuggers like purify for {set i 0} {$i<10} {incr i} { @@ -83,23 +83,23 @@ test dict-2.8 {dict create command - #-quoting in string rep} -body { 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.12 {dict get command} -returnCodes error -body { + dict get +} -result {wrong # args: should be "dict get dictionary ?key key ...?"} test dict-3.13 {dict get command} { set dict [dict get {a b c d}] if {$dict eq "a b c d"} { @@ -110,9 +110,9 @@ test dict-3.13 {dict get command} { set 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}} +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-4.1 {dict replace command} { getOrder [dict replace {a b c d}] a c @@ -126,18 +126,18 @@ test dict-4.3 {dict replace command} { 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}} +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} @@ -149,9 +149,9 @@ test dict-5.5 {dict remove command} { getOrder [dict remove {a b c d}] a c } {a b c d 2} 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-6.1 {dict keys command} {dict keys {a b}} a test dict-6.2 {dict keys command} {dict keys {c d}} c @@ -160,15 +160,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 @@ -177,59 +177,58 @@ 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 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} { - list [catch {dict exists {a {b c d}} a c} msg] $msg -} {1 {missing value to go with key}} -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.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} { +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} { set dictv [dict create \ @@ -275,54 +274,54 @@ test dict-11.8 {dict incr command} { set dictv {a 1} dict incr dictv a 2 } {a 3} -test dict-11.9 {dict incr command} { +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 +} -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} { + dict incr dictv a dummy +} -result {expected integer but got "dummy"} +test dict-11.11 {dict incr command} -setup { catch {unset dictv} +} -body { dict incr dictv a -} {a 1} -test dict-11.12 {dict incr command} { +} -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 +} -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 +} -result {wrong # args: should be "dict incr varName 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} { + dict incr dictv +} -result {wrong # args: should be "dict incr varName key ?increment?"} +test dict-11.15 {dict incr command: write failure} -setup { catch {unset dictVar} +} -body { set dictVar(block) {} - set result [list [catch {dict incr dictVar a} msg] $msg] + dict incr dictVar a +} -returnCodes error -cleanup { catch {unset dictVar} - set result -} {1 {can't set "dictVar": variable is array}} +} -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} { @@ -350,27 +349,28 @@ test dict-12.5 {dict lappend command} { catch {unset dictv} dict lappend dictv a b } {a b} -test dict-12.6 {dict lappend command} { +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 +} -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 -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} { + dict lappend dictv a a +} -result {unmatched open brace in list} +test dict-12.10 {dict lappend command: write failure} -setup { catch {unset dictVar} +} -body { set dictVar(block) {} - set result [list [catch {dict lappend dictVar a x} msg] $msg] + dict lappend dictVar a x +} -returnCodes error -cleanup { catch {unset dictVar} - set result -} {1 {can't set "dictVar": variable is array}} +} -result {can't set "dictVar": variable is array} test dict-13.1 {dict append command} { set dictv {a a} @@ -397,48 +397,49 @@ test dict-13.5 {dict append command} { catch {unset dictv} dict append dictv a b } {a b} -test dict-13.6 {dict append command} { +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} { + dict append dictv a a +} -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 { catch {unset dictVar} +} -body { set dictVar(block) {} - set result [list [catch {dict append dictVar a x} msg] $msg] + dict append dictVar a x +} -returnCodes error -cleanup { catch {unset dictVar} - set result -} {1 {can't set "dictVar": variable is array}} +} -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-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.1 {dict for command: syntax} -returnCodes error -body { + dict for +} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"} +test dict-14.2 {dict for command: syntax} -returnCodes error -body { + dict for x +} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"} +test dict-14.3 {dict for command: syntax} -returnCodes error -body { + dict for x x +} -result {wrong # args: should be "dict for {keyVar valueVar} 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 {keyVar valueVar} 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} { # This test confirms that [dict keys], [dict values] and [dict for] # all traverse a dictionary in the same order. @@ -466,7 +467,7 @@ test dict-14.10 {dict for command: script results} { continue error "shouldn't get here" } - set times + return $times } 2 test dict-14.11 {dict for command: script results} { set times 0 @@ -475,7 +476,7 @@ test dict-14.11 {dict for command: script results} { break error "shouldn't get here" } - set times + return $times } 1 test dict-14.12 {dict for command: script results} { set times 0 @@ -495,15 +496,13 @@ 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} { set dictVar {a b c d e f g h} @@ -533,44 +532,40 @@ test dict-14.15 {dict for command: keys are unique and iterated over once only} set 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} # There's probably a lot more tests to add here. Really ought to use a # coverage tool for this job... @@ -608,26 +603,27 @@ test dict-15.8 {dict set command: creates variables} { dict set dictVar a x set dictVar } {a x} -test dict-15.9 {dict set command: write failure} { +test dict-15.9 {dict set command: write failure} -setup { catch {unset dictVar} +} -body { set dictVar(block) {} - set result [list [catch {dict set dictVar a x} msg] $msg] + dict set dictVar a x +} -returnCodes error -cleanup { 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} { +} -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 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 - list [catch {dict set dictVar b c} msg] $msg -} {1 {missing value to go with key}} + dict set dictVar b c +} -result {missing value to go with key} test dict-16.1 {dict unset command} { set dictVar {a b c d} @@ -645,28 +641,30 @@ test dict-16.4 {dict unset command} { set dictVar {a {b c d e}} dict unset dictVar a b } {a {d e}} -test dict-16.5 {dict unset command} { +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 +} -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} { + dict unset dictVar c d +} -result {key "c" not known in dictionary} +test dict-16.7 {dict unset command} -setup { catch {unset 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} { +} -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 { catch {unset dictVar} +} -body { set dictVar(block) {} - set result [list [catch {dict unset dictVar a} msg] $msg] + dict unset dictVar a +} -returnCodes error -cleanup { catch {unset dictVar} - set result -} {1 {can't set "dictVar": variable is array}} +} -result {can't set "dictVar": variable is array} test dict-17.1 {dict filter command: key} { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} @@ -680,12 +678,12 @@ test dict-17.3 {dict filter command: key} { 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.4 {dict filter command: key} -returnCodes error -body { + dict filter {} key +} -result {wrong # args: should be "dict filter dictionary key globPattern"} +test dict-17.5 {dict filter command: key} -returnCodes error -body { + dict filter {} key a a +} -result {wrong # args: should be "dict filter dictionary key globPattern"} test dict-17.6 {dict filter command: value} { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} dict filter $dictVar value c @@ -698,12 +696,12 @@ test dict-17.8 {dict filter command: value} { 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.9 {dict filter command: value} -returnCodes error -body { + dict filter {} value +} -result {wrong # args: should be "dict filter dictionary value globPattern"} +test dict-17.10 {dict filter command: value} -returnCodes error -body { + dict filter {} value a a +} -result {wrong # args: should be "dict filter dictionary value globPattern"} test dict-17.11 {dict filter command: script} { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} set n 0 @@ -712,9 +710,11 @@ test dict-17.11 {dict filter command: script} { 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.12 {dict filter command: script} -returnCodes error -body { + dict filter {a b} script {k v} { + concat $k $v + } +} -result {expected boolean value but got "a b"} test dict-17.13 {dict filter command: script} { list [catch {dict filter {a b} script {k v} {error x}} msg] $msg \ $::errorInfo @@ -741,38 +741,36 @@ test dict-17.15 {dict filter command: script} { }] $n } {{} 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} { 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}} +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 ..."} +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 { @@ -801,129 +799,124 @@ test dict-18.2 {dict-list relationship} { # 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] + }} +} [dict create c d a b] test dict-19.2 {dict: testing for leaks} -setup { proc getbytes {} { set lines [split [memory info] "\n"] lindex [lindex $lines 3] 3 } +} -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} + set end [getbytes] + for {set i 0} {$i < 5} {incr i} { + 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 { - set end [getbytes] - for {set i 0} {$i < 5} {incr i} { - 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 + }} set tmp $end set end [getbytes] } @@ -942,16 +935,16 @@ test dict-20.2 {dict merge command} { } {a b c d e f 3} 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} 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} @@ -965,18 +958,18 @@ 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} -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 varName 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 varName 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 varName 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"} +} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} test dict-21.5 {dict update command} { set a {b c} set result {} @@ -1040,7 +1033,7 @@ test dict-21.12 {dict update command} { getOrder $a b d f } {b c d e f g 3} 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 @@ -1048,25 +1041,22 @@ test dict-21.13 {dict update command: compilation} { break } } - return $d - } - getOrder [dicttest {a 1 c 2}] b c + return [getOrder $d b c] + }} {a 1 c 2} } {b 1 c 2 2} 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]} { set foo {a {b {c {d {e 1}}}}} @@ -1082,7 +1072,7 @@ test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} { string range [append foo OK] end-1 end } 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 { @@ -1093,8 +1083,7 @@ test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} { } } } - } - dicttest + }} string range [append foo OK] end-1 end } OK |