diff options
Diffstat (limited to 'tcl8.6/tests/dict.test')
| -rw-r--r-- | tcl8.6/tests/dict.test | 2065 |
1 files changed, 0 insertions, 2065 deletions
diff --git a/tcl8.6/tests/dict.test b/tcl8.6/tests/dict.test deleted file mode 100644 index a6b0cb4..0000000 --- a/tcl8.6/tests/dict.test +++ /dev/null @@ -1,2065 +0,0 @@ -# This test file covers the dictionary object type and the dict command used -# to work with values of that type. -# -# This file contains a collection of tests for one or more of the Tcl built-in -# commands. Sourcing this file into Tcl runs the tests and generates output -# for errors. No output means no errors were found. -# -# Copyright (c) 2003-2009 Donal K. Fellows -# See the file "license.terms" for information on usage and redistribution of -# this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} - -# Used for constraining memory leak tests -testConstraint memory [llength [info commands memory]] -if {[testConstraint memory]} { - proc memtest script { - set end [lindex [split [memory info] \n] 3 3] - for {set i 0} {$i < 5} {incr i} { - uplevel 1 $script - set tmp $end - set end [lindex [split [memory info] \n] 3 3] - } - expr {$end - $tmp} - } -} - -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 -} {} -test dict-2.2 {dict create command} { - dict create a b -} {a b} -test dict-2.3 {dict create command} -body { - set result {} - set dict [dict create a b c d] - # Can't compare directly as ordering of values is undefined - foreach key {a c} { - set idx [lsearch -exact $dict $key] - if {$idx & 1} { - error "found $key at odd index $idx in $dict" - } - lappend result [lindex $dict [expr {$idx+1}]] - } - return $result -} -cleanup { - unset result dict key idx -} -result {b d} -test dict-2.4 {dict create command} -returnCodes error -body { - dict create a -} -result {wrong # args: should be "dict create ?key value ...?"} -test dict-2.5 {dict create command} -returnCodes error -body { - dict create a b c -} -result {wrong # args: should be "dict create ?key value ...?"} -test dict-2.6 {dict create command - initialse refcount field!} -body { - # Bug 715751 will show up in memory debuggers like purify - for {set i 0} {$i<10} {incr i} { - set dictv [dict create a 0] - 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} -returnCodes error -body { - dict get {a b c d} b -} -result {key "b" not known in dictionary} -test dict-3.5 {dict get command} {dict get {a {p q r s} b {u v x y}} a p} q -test dict-3.6 {dict get command} {dict get {a {p q r s} b {u v x y}} a r} s -test dict-3.7 {dict get command} {dict get {a {p q r s} b {u v x y}} b u} v -test dict-3.8 {dict get command} {dict get {a {p q r s} b {u v x y}} b x} y -test dict-3.9 {dict get command} -returnCodes error -body { - dict get {a {p q r s} b {u v x y}} a z -} -result {key "z" not known in dictionary} -test dict-3.10 {dict get command} -returnCodes error -body { - dict get {a {p q r s} b {u v x y}} c z -} -result {key "c" not known in dictionary} -test dict-3.11 {dict get command} {dict get [dict create a b c d] a} b -test dict-3.12 {dict get command} -returnCodes error -body { - dict get -} -result {wrong # args: should be "dict get dictionary ?key ...?"} -test dict-3.13 {dict get command} -body { - set dict [dict get {a b c d}] - if {$dict eq "a b c d"} { - return OK - } elseif {$dict eq "c d a b"} { - return reordered - } else { - return $dict - } -} -cleanup { - unset dict -} -result OK -test dict-3.14 {dict get command} -returnCodes error -body { - dict get {a b c d} a c -} -result {missing value to go with key} -test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body { - apply {{} { - dict set a(z) b c - dict get $a(z) d - }} -} -returnCodes error -result {key "d" not known in dictionary} -test dict-3.16 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;set l} {p 1 p 2 q 3} -test dict-3.17 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;llength $l} 6 - -test dict-4.1 {dict replace command} { - dict replace {a b c d} -} {a b c d} -test dict-4.2 {dict replace command} { - dict replace {a b c d} e f -} {a b c d e f} -test dict-4.3 {dict replace command} { - dict replace {a b c d} c f -} {a b c f} -test dict-4.4 {dict replace command} { - 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} { - dict remove {a b c d} -} {a b c d} -test dict-5.6 {dict remove command} {dict remove {a b} c} {a b} -test dict-5.7 {dict remove command} -returnCodes error -body { - dict remove -} -result {wrong # args: should be "dict remove dictionary ?key ...?"} -test dict-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 -test dict-6.3 {dict keys command} {lsort [dict keys {a b c d}]} {a c} -test dict-6.4 {dict keys command} {dict keys {a b c d} a} a -test dict-6.5 {dict keys command} {dict keys {a b c d} c} c -test dict-6.6 {dict keys command} {dict keys {a b c d} e} {} -test dict-6.7 {dict keys command} {lsort [dict keys {a b c d ca da} c*]} {c ca} -test dict-6.8 {dict keys command} -returnCodes error -body { - dict keys -} -result {wrong # args: should be "dict keys dictionary ?pattern?"} -test dict-6.9 {dict keys command} -returnCodes error -body { - dict keys {} a b -} -result {wrong # args: should be "dict keys dictionary ?pattern?"} -test dict-6.10 {dict keys command} -returnCodes error -body { - dict keys a -} -result {missing value to go with key} - -test dict-7.1 {dict values command} {dict values {a b}} b -test dict-7.2 {dict values command} {dict values {c d}} d -test dict-7.3 {dict values command} {lsort [dict values {a b c d}]} {b d} -test dict-7.4 {dict values command} {dict values {a b c d} b} b -test dict-7.5 {dict values command} {dict values {a b c d} d} d -test dict-7.6 {dict values command} {dict values {a b c d} e} {} -test dict-7.7 {dict values command} {lsort [dict values {a b c d ca da} d*]} {d da} -test dict-7.8 {dict values command} -returnCodes error -body { - dict values -} -result {wrong # args: should be "dict values dictionary ?pattern?"} -test dict-7.9 {dict values command} -returnCodes error -body { - dict values {} a b -} -result {wrong # args: should be "dict values dictionary ?pattern?"} -test dict-7.10 {dict values command} -returnCodes error -body { - dict values a -} -result {missing value to go with key} - -test dict-8.1 {dict size command} {dict size {}} 0 -test dict-8.2 {dict size command} {dict size {a b}} 1 -test dict-8.3 {dict size command} {dict size {a b c d}} 2 -test dict-8.4 {dict size command} -returnCodes error -body { - dict size -} -result {wrong # args: should be "dict size dictionary"} -test dict-8.5 {dict size command} -returnCodes error -body { - dict size a b -} -result {wrong # args: should be "dict size dictionary"} -test dict-8.6 {dict size command} -returnCodes error -body { - dict size a -} -result {missing value to go with key} - -test dict-9.1 {dict exists command} {dict exists {a b} a} 1 -test dict-9.2 {dict exists command} {dict exists {a b} b} 0 -test dict-9.3 {dict exists command} {dict exists {a {b c}} a b} 1 -test dict-9.4 {dict exists command} {dict exists {a {b c}} a c} 0 -test dict-9.5 {dict exists command} {dict exists {a {b c}} b c} 0 -test dict-9.6 {dict exists command} {dict exists {a {b c d}} a c} 0 -test dict-9.7 {dict exists command} -returnCodes error -body { - dict exists -} -result {wrong # args: should be "dict exists dictionary key ?key ...?"} -test dict-9.8 {dict exists command} -returnCodes error -body { - dict exists {} -} -result {wrong # args: should be "dict exists dictionary key ?key ...?"} - -test dict-10.1 {dict info command} -body { - # Actual string returned by this command is undefined; it is - # intended for human consumption and not for use by scripts. - dict info {} -} -match glob -result * -test dict-10.2 {dict info command} -returnCodes error -body { - dict info -} -result {wrong # args: should be "dict info dictionary"} -test dict-10.3 {dict info command} -returnCodes error -body { - dict info {} x -} -result {wrong # args: should be "dict info dictionary"} -test dict-10.4 {dict info command} -returnCodes error -body { - dict info x -} -result {missing value to go with key} - -test dict-11.1 {dict incr command: unshared value} -body { - set dictv [dict create \ - a [string index "=0=" 1] \ - b [expr {1+2}] \ - c [expr {wide(0x80000000)+1}]] - 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}]] - 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}]] - 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] - 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] - 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] - 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}]] - 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 -} -cleanup { - unset dictv -} -result {a 3} -test dict-11.9 {dict incr command} -returnCodes error -body { - set dictv {a dummy} - 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} - 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 -} -cleanup { - unset dictv -} -result {a 1} -test dict-11.12 {dict incr command} -returnCodes error -body { - set dictv a - 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 - 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 - 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) {} - 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} { - apply {{} { - set v {a 0 b 0 c 0} - dict incr v a - dict incr v b 1 - dict incr v c 2 - dict incr v d 3 - list [dict get $v a] [dict get $v b] [dict get $v c] [dict get $v d] - }} -} {1 1 2 3} -test dict-11.17 {dict incr command: compilation} { - apply {{} { - set dictv {a 1} - dict incr dictv a 2 - }} -} {a 3} - -test dict-12.1 {dict lappend command} -body { - set dictv {a a} - dict lappend dictv a -} -cleanup { - unset dictv -} -result {a a} -test dict-12.2 {dict lappend command} -body { - set dictv {a a} - set sharing [dict values $dictv] - dict lappend dictv a b -} -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 -} -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 -} -cleanup { - unset dictv -} -result {a {a b}} -test dict-12.4 {dict lappend command} -body { - set dictv {} - dict lappend dictv a x y z -} -cleanup { - unset dictv -} -result {a {x y z}} -test dict-12.5 {dict lappend command} -body { - unset -nocomplain dictv - dict lappend dictv a b -} -cleanup { - unset dictv -} -result {a b} -test dict-12.6 {dict lappend command} -returnCodes error -body { - set dictv a - 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 "\{"] - 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) {} - 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} -body { - set dictv {a a} - dict append dictv a -} -cleanup { - unset dictv -} -result {a a} -test dict-13.2 {dict append command} -body { - set dictv {a a} - set sharing [dict values $dictv] - dict append dictv a b -} -cleanup { - unset dictv sharing -} -result {a ab} -test dict-13.3 {dict append command} -body { - set dictv {a a} - dict append dictv a b c -} -cleanup { - unset dictv -} -result {a abc} -test dict-13.2.1 {dict append command} -body { - set dictv [dict create a [string index =a= 1]] - dict append dictv a b -} -cleanup { - unset dictv -} -result {a ab} -test dict-13.4 {dict append command} -body { - set dictv {} - dict append dictv a x y z -} -cleanup { - unset dictv -} -result {a xyz} -test dict-13.5 {dict append command} -body { - unset -nocomplain dictv - dict append dictv a b -} -cleanup { - unset dictv -} -result {a b} -test dict-13.6 {dict append command} -returnCodes error -body { - set dictv a - dict append dictv a a -} -cleanup { - unset dictv -} -result {missing value to go with key} -test dict-13.7 {dict append command} -returnCodes error -body { - dict append -} -result {wrong # args: should be "dict append 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) {} - 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} -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} - set keys {} - set values {} - dict for {k v} $dictv { - lappend keys $k - lappend values $v - } - set result [expr { - $keys eq [dict keys $dictv] && $values eq [dict values $dictv] - }] - expr {$result ? "YES" : [list "NO" $dictv $keys $values]} -} -cleanup { - unset result keys values k v dictv -} -result YES -test dict-14.9 {dict for command} { - dict for {k v} {} { - error "unexpected execution of 'dict for' body" - } -} {} -test dict-14.10 {dict for command: script results} -body { - set times 0 - dict for {k v} {a a b b} { - incr times - continue - error "shouldn't get here" - } - return $times -} -cleanup { - unset times k v -} -result 2 -test dict-14.11 {dict for command: script results} -body { - set times 0 - dict for {k v} {a a b b} { - incr times - break - error "shouldn't get here" - } - return $times -} -cleanup { - unset times k v -} -result 1 -test dict-14.12 {dict for command: script results} -body { - set times 0 - list [catch { - dict for {k v} {a a b b} { - incr times - error test - } - } msg] $msg $times $::errorInfo -} -cleanup { - unset times k v msg -} -result {1 test 1 {test - while executing -"error test" - ("dict for" body line 3) - invoked from within -"dict for {k v} {a a b b} { - incr times - error test - }"}} -test dict-14.13 {dict for command: script results} { - apply {{} { - dict for {k v} {a b} { - return ok,$k,$v - error "skipped return completely" - } - error "return didn't go far enough" - }} -} ok,a,b -test dict-14.14 {dict for command: handle representation loss} -body { - set dictVar {a b c d e f g h} - set keys {} - set values {} - dict for {k v} $dictVar { - if {[llength $dictVar]} { - lappend keys $k - lappend values $v - } - } - list [lsort $keys] [lsort $values] -} -cleanup { - unset dictVar keys values k v -} -result {{a c e g} {b d f h}} -test dict-14.15 {dict for command: keys are unique and iterated over once only} -setup { - unset -nocomplain accum - array set accum {} -} -body { - set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} - dict for {k v} $dictVar { - append accum($k) $v, - } - set result [lsort [array names accum]] - lappend result : - foreach k $result { - catch {lappend result $accum($k)} - } - return $result -} -cleanup { - unset dictVar k v result accum -} -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,} -test dict-14.16 {dict for command in compilation context} { - apply {{} { - set res {x x x x x x} - dict for {k v} {a 0 b 1 c 2 d 3 e 4 f 5} { - lset res $v $k - continue - } - return $res - }} -} {a b c d e f} -test dict-14.17 {dict for command in compilation context} { - # Bug 1379349 - apply {{} { - set d [dict create a 1] ;# Dict must be unshared! - dict for {k v} $d { - dict set d $k 0 ;# Any modification will do - } - return $d - }} -} {a 0} -test dict-14.18 {dict for command in compilation context} { - # Bug 1382528 - apply {{} { - dict for {k v} {} {} ;# Note empty dict - catch { error foo } ;# Note compiled [catch] - }} -} 1 -test dict-14.19 {dict for and invalid dicts: bug 1531184} -body { - di[list]ct for {k v} x {} -} -returnCodes 1 -result {missing value to go with key} -test dict-14.20 {dict for stack space compilation: bug 1903325} { - apply {{x y args} { - dict for {a b} $x {} - concat "c=$y,$args" - }} {} 1 2 3 -} {c=1,2 3} -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} -body { - set dictVar {} - dict set dictVar a x -} -cleanup { - unset dictVar -} -result {a x} -test dict-15.2 {dict set command} -body { - set dictvar {a {}} - dict set dictvar a b x -} -cleanup { - unset dictvar -} -result {a {b x}} -test dict-15.3 {dict set command} -body { - set dictvar {a {b {}}} - dict set dictvar a b c x -} -cleanup { - unset dictvar -} -result {a {b {c x}}} -test dict-15.4 {dict set command} -body { - set dictVar {a y} - dict set dictVar a x -} -cleanup { - unset dictVar -} -result {a x} -test dict-15.5 {dict set command} -body { - set dictVar {a {b y}} - dict set dictVar a b x -} -cleanup { - unset dictVar -} -result {a {b x}} -test dict-15.6 {dict set command} -body { - set dictVar {a {b {c y}}} - dict set dictVar a b c x -} -cleanup { - unset dictVar -} -result {a {b {c x}}} -test dict-15.7 {dict set command: path creation} -body { - set dictVar {} - dict set dictVar a b x -} -cleanup { - unset dictVar -} -result {a {b x}} -test dict-15.8 {dict set command: creates variables} -setup { - unset -nocomplain dictVar -} -body { - dict set dictVar a x - return $dictVar -} -cleanup { - unset dictVar -} -result {a x} -test dict-15.9 {dict set command: write failure} -setup { - unset -nocomplain dictVar -} -body { - set dictVar(block) {} - 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 - dict set dictVar b c -} -cleanup { - unset dictVar -} -result {missing value to go with key} - -test dict-16.1 {dict unset command} -body { - set dictVar {a b c d} - dict unset dictVar a -} -cleanup { - unset dictVar -} -result {c d} -test dict-16.2 {dict unset command} -body { - set dictVar {a b c d} - dict unset dictVar c -} -cleanup { - unset dictVar -} -result {a b} -test dict-16.3 {dict unset command} -body { - set dictVar {a b} - dict unset dictVar c -} -cleanup { - unset dictVar -} -result {a b} -test dict-16.4 {dict unset command} -body { - set dictVar {a {b c d e}} - dict unset dictVar a b -} -cleanup { - unset dictVar -} -result {a {d e}} -test dict-16.5 {dict unset command} -returnCodes error -body { - set dictVar a - dict unset dictVar a -} -cleanup { - unset dictVar -} -result {missing value to go with key} -test dict-16.6 {dict unset command} -returnCodes error -body { - set dictVar {a b} - dict unset dictVar c d -} -cleanup { - unset dictVar -} -result {key "c" not known in dictionary} -test dict-16.7 {dict unset command} -setup { - unset -nocomplain dictVar -} -body { - list [info exists dictVar] [dict unset dictVar a] [info exists dictVar] -} -cleanup { - unset dictVar -} -result {0 {} 1} -test dict-16.8 {dict unset command} -returnCodes error -body { - dict unset dictVar -} -result {wrong # args: should be "dict unset dictVarName key ?key ...?"} -test dict-16.9 {dict unset command: write failure} -setup { - unset -nocomplain dictVar -} -body { - set dictVar(block) {} - 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} -body { - set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} - dict filter $dictVar key a2 -} -cleanup { - unset dictVar -} -result {a2 b} -test dict-17.2 {dict filter command: key} -body { - set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} - dict size [dict filter $dictVar key *] -} -cleanup { - unset dictVar -} -result 6 -test dict-17.3 {dict filter command: key} -body { - set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} - dict filter $dictVar key ??? -} -cleanup { - unset dictVar -} -result {foo bar bar foo} -test dict-17.4 {dict filter command: key - no patterns} { - dict filter {a b c d} key -} {} -test dict-17.4.1 {dict filter command: key - many patterns} { - dict filter {a1 a a2 b b1 c b2 d foo bar bar foo} key a? b? -} {a1 a a2 b b1 c b2 d} -test dict-17.5 {dict filter command: key - bad dict} -returnCodes error -body { - dict filter {a b c} key -} -result {missing value to go with key} -test dict-17.6 {dict filter command: value} -body { - set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} - dict filter $dictVar value c -} -cleanup { - unset dictVar -} -result {b1 c} -test dict-17.7 {dict filter command: value} -body { - set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} - dict size [dict filter $dictVar value *] -} -cleanup { - unset dictVar -} -result 6 -test dict-17.8 {dict filter command: value} -body { - set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} - dict filter $dictVar value ??? -} -cleanup { - unset dictVar -} -result {foo bar bar foo} -test dict-17.9 {dict filter command: value - no patterns} { - dict filter {a b c d} value -} {} -test dict-17.9.1 {dict filter command: value - many patterns} { - dict filter {a a1 b a2 c b1 foo bar bar foo d b2} value a? b? -} {a a1 b a2 c b1 d b2} -test dict-17.10 {dict filter command: value - bad dict} -body { - dict filter {a b c} value a -} -returnCodes error -result {missing value to go with key} -test dict-17.11 {dict filter command: script} -body { - set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} - set n 0 - list [dict filter $dictVar script {k v} { - incr n - expr {[string length $k] == [string length $v]} - }] $n -} -cleanup { - unset dictVar n k v -} -result {{foo bar bar foo} 6} -test dict-17.12 {dict filter command: script} -returnCodes error -body { - dict filter {a b} script {k v} { - concat $k $v - } -} -cleanup { - unset k v -} -result {expected boolean value but got "a b"} -test dict-17.13 {dict filter command: script} -body { - list [catch {dict filter {a b} script {k v} {error x}} msg] $msg \ - $::errorInfo -} -cleanup { - unset k v msg -} -result {1 x {x - while executing -"error x" - ("dict filter" script line 1) - invoked from within -"dict filter {a b} script {k v} {error x}"}} -test dict-17.14 {dict filter command: script} -setup { - set n 0 -} -body { - list [dict filter {a b c d} script {k v} { - incr n - break - error boom! - }] $n -} -cleanup { - unset n k v -} -result {{} 1} -test dict-17.15 {dict filter command: script} -setup { - set n 0 -} -body { - list [dict filter {a b c d} script {k v} { - incr n - continue - error boom! - }] $n -} -cleanup { - unset n k v -} -result {{} 2} -test dict-17.16 {dict filter command: script} { - apply {{} { - dict filter {a b} script {k v} { - return ok,$k,$v - error "skipped return completely" - } - error "return didn't go far enough" - }} -} ok,a,b -test dict-17.17 {dict filter command: script} -body { - dict filter {a b} script {k k} {continue} - return $k -} -cleanup { - unset k -} -result b -test dict-17.18 {dict filter command: script} -returnCodes error -body { - dict filter {a b} script {k k} -} -result {wrong # args: should be "dict filter dictionary script {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 - return $l -} -cleanup { - unset l -} -result {1 2 3 4 5 6 7 8 9 0 q w e r t y} -test dict-18.2 {dict-list relationship} -body { - # Test that the dictionary is a valid list - set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2] - for {set t 0} {$t < 5} {incr t} { - llength $d - dict lappend d "abc def" "\}\{" - dict append d "a\{b" "\}" - dict incr d "c\}d" 1 - } - llength $d -} -cleanup { - unset d t -} -result 6 -test dict-18.3 {dict-list relationship} -body { - set ld [list a b c d c e f g] - list [string length $ld] [dict size $ld] [llength $ld] -} -cleanup { - unset ld -} -result {15 3 8} -test dict-18.4 {dict-list relationship} -body { - set ld [list a b c d c e f g] - list [llength $ld] [dict size $ld] [llength $ld] -} -cleanup { - unset ld -} -result {8 3 8} - -# 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} { - apply {{} { - set successors [dict create x {c d}] - dict set successors x a b - dict get $successors x - }} -} [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 - 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} - - # 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 - - # 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 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 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 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 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 - }} - } -} -result 0 -test dict-19.3 {testing for leaks - Bug 2874678} -constraints memory -body { - set d aDictVar; # Force interpreted [dict incr] - memtest { - dict incr $d aKey 0 - unset $d - } -} -cleanup { - unset d -} -result 0 - -test dict-20.1 {dict merge command} { - dict merge -} {} -test dict-20.2 {dict merge command} { - 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 error -test dict-20.4 {dict merge command} { - 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 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 error -test dict-20.7 {dict merge command} { - dict merge {a b c d e f} {e x g h} -} {a b c d e x g h} -test dict-20.8 {dict merge command} { - dict merge {a b c d} {a x c y} -} {a x c y} -test dict-20.9 {dict merge command} { - dict merge {a b c d} {c y a x} -} {a x c y} -test dict-20.10 {dict merge command} { - 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} -returnCodes 1 -body { - dict update -} -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 -} -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 -} -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 -} -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 {} - dict update a b bb { - lappend result $a $bb - } - lappend result $a -} -cleanup { - unset a result bb -} -result {{b c} c {b c}} -test dict-21.6 {dict update command} -body { - set a {b c} - set result {} - set bb {} - dict update a b bb { - lappend result $a $bb [set bb d] - } - lappend result $a -} -cleanup { - unset a result bb -} -result {{b c} c d {b d}} -test dict-21.7 {dict update command} -body { - set a {b c} - set result {} - set bb {} - dict update a b bb { - lappend result $a $bb [unset bb] - } - lappend result $a -} -cleanup { - unset a result -} -result {{b c} c {} {}} -test dict-21.8 {dict update command} -body { - set a {b c d e} - dict update a b v1 d v2 { - lassign "$v1 $v2" v2 v1 - } - 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 -} -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 - } - } - 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 - } - 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 - } - return $a -} -cleanup { - unset a v1 v2 v3 -} -result {b c d e f g} -test dict-21.13 {dict update command: compilation} { - apply {d { - while 1 { - dict update d a alpha b beta { - set beta $alpha - unset alpha - break - } - } - return $d - }} {a 1 c 2} -} {c 2 b 1} -test dict-21.14 {dict update command: compilation} { - apply {x { - set indices {2 3} - trace add variable aa write "string length \$indices ;#" - dict update x k aa l bb {} - }} {k 1 l 2} -} {} -test dict-21.15 {dict update command: compilation} { - apply {x { - set indices {2 3} - trace add variable aa read "string length \$indices ;#" - dict update x k aa l bb {} - }} {k 1 l 2} -} {} -test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} -body { - set foo {a {b {c {d {e 1}}}}} - dict update foo a t { - dict update t b t { - dict update t c t { - dict update t d t { - dict incr t e - } - } - } - } - string range [append foo OK] end-1 end -} -cleanup { - unset foo t -} -result OK -test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} { - apply {{} { - set foo {a {b {c {d {e 1}}}}} - dict update foo a t { - dict update t b t { - dict update t c t { - dict update t d t { - dict incr t e - } - } - } - } - string range [append foo OK] end-1 end - }} -} OK - -test dict-22.1 {dict with command} -body { - dict with -} -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"} -test dict-22.2 {dict with command} -body { - dict with v -} -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} -body { - set a {b c d e} - unset -nocomplain b d - set result [list [info exist b] [info exist d]] - dict with a { - lappend result [info exist b] [info exist d] $b $d - } - return $result -} -cleanup { - unset a b d result -} -result {0 0 1 1 c e} -test dict-22.5 {dict with command} -body { - set a {b c d e} - dict with a { - lassign "$b $d" d b - } - 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 - } - return $a -} -cleanup { - unset a d f -} -result {d e} -test dict-22.7 {dict with command} -body { - set a {b c d e} - dict with a { - dict unset a b - } - return $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 - } - return $a -} -cleanup { - unset a b -} -result {b {b c}} -test dict-22.9 {dict with command} -body { - set a {b {c d}} - dict with a b { - set c $c$c - } - return $a -} -cleanup { - unset a c -} -result {b {c dd}} -test dict-22.10 {dict with command: result handling tricky case} -body { - set a {b {c d}} - foreach i {0 1} { - if {$i} break - dict with a b { - set a {} - # We're checking to see if we lose this break - break - } - } - list $i $a -} -cleanup { - unset a i c -} -result {0 {}} -test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} -body { - set foo {t {t {t {inner 1}}}} - dict with foo { - dict with t { - dict with t { - dict with t { - incr inner - } - } - } - } - string range [append foo OK] end-1 end -} -cleanup { - unset foo t inner -} -result OK -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 {{} {apply {n { - set e {} - set k {} - dict for {a b} {c {d {e {f g}}}} { - ::tcl::dict::for {h i} $b { - dict update i e j { - ::tcl::dict::update j f k { - return [expr {$n - [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 {{} {apply {n { - set e {} - set k {} - dict for {a { -b -}} {c {d {e {f g}}}} { - ::tcl::dict::for {h { -i -}} ${ -b -} { - dict update { -i -} e { -j -} { - ::tcl::dict::update { -j -} f k { - return [expr {$n - [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 - apply {{} {tcl::dict::lappend foo bar \ - [format baz]}} -} {bar baz} -test dict-23.4 {CompileWord OBOE} { - apply {n { - dict set foo {*}{ - } [return [incr n -[linenumber]]] val - }} [linenumber] -} 1 -test dict-23.5 {CompileWord OBOE} { - # segfault when buggy - apply {{} {tcl::dict::incr foo \ - [format bar]}} -} {bar 1} -test dict-23.6 {CompileWord OBOE} { - apply {n { - dict get {a b} {*}{ - } [return [incr n -[linenumber]]] - }} [linenumber] -} 1 -test dict-23.7 {CompileWord OBOE} { - apply {n { - dict for {a b} [return [incr n -[linenumber]]] {*}{ - } {} - }} [linenumber] -} 2 -test dict-23.8 {CompileWord OBOE} { - apply {n { - dict update foo {*}{ - } [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 - -test dict-25.1 {compiled dict update with low-refcount values [Bug d553228d9f]} { - # Test crashes on failure - apply {{} { - lassign {} item - dict update item item item two two {} - }} -} {} - -# cleanup -::tcltest::cleanupTests -return - -# Local Variables: -# mode: tcl -# End: |