[25] | 1 | # This test file covers the dictionary object type and the dict |
---|
| 2 | # command used to work with values of that type. |
---|
| 3 | # |
---|
| 4 | # This file contains a collection of tests for one or more of the Tcl |
---|
| 5 | # built-in commands. Sourcing this file into Tcl runs the tests and |
---|
| 6 | # generates output for errors. No output means no errors were found. |
---|
| 7 | # |
---|
| 8 | # Copyright (c) 2003 Donal K. Fellows |
---|
| 9 | # See the file "license.terms" for information on usage and redistribution |
---|
| 10 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 11 | # |
---|
| 12 | # RCS: @(#) $Id: dict.test,v 1.24 2008/03/16 17:00:44 dkf Exp $ |
---|
| 13 | |
---|
| 14 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
| 15 | package require tcltest 2 |
---|
| 16 | namespace import -force ::tcltest::* |
---|
| 17 | } |
---|
| 18 | |
---|
| 19 | # Used for constraining memory leak tests |
---|
| 20 | testConstraint memory [llength [info commands memory]] |
---|
| 21 | |
---|
| 22 | # Procedure to help check the contents of a dictionary. Note that we |
---|
| 23 | # can't just compare the string version because the order of the |
---|
| 24 | # elements is (deliberately) not defined. This is because it is |
---|
| 25 | # dependent on the underlying hash table implementation and also |
---|
| 26 | # potentially on the history of the value itself. Net result: you |
---|
| 27 | # cannot safely assume anything about the ordering of values. |
---|
| 28 | proc getOrder {dictVal args} { |
---|
| 29 | foreach key $args { |
---|
| 30 | lappend result $key [dict get $dictVal $key] |
---|
| 31 | } |
---|
| 32 | lappend result [dict size $dictVal] |
---|
| 33 | return $result |
---|
| 34 | } |
---|
| 35 | |
---|
| 36 | test dict-1.1 {dict command basic syntax} { |
---|
| 37 | list [catch {dict} msg] $msg |
---|
| 38 | } {1 {wrong # args: should be "dict subcommand ?argument ...?"}} |
---|
| 39 | test dict-1.2 {dict command basic syntax} { |
---|
| 40 | list [catch {dict ?} msg] $msg |
---|
| 41 | } {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}} |
---|
| 42 | |
---|
| 43 | test dict-2.1 {dict create command} { |
---|
| 44 | dict create |
---|
| 45 | } {} |
---|
| 46 | test dict-2.2 {dict create command} { |
---|
| 47 | dict create a b |
---|
| 48 | } {a b} |
---|
| 49 | test dict-2.3 {dict create command} { |
---|
| 50 | set result {} |
---|
| 51 | set dict [dict create a b c d] |
---|
| 52 | # Can't compare directly as ordering of values is undefined |
---|
| 53 | foreach key {a c} { |
---|
| 54 | set idx [lsearch -exact $dict $key] |
---|
| 55 | if {$idx & 1} { |
---|
| 56 | error "found $key at odd index $idx in $dict" |
---|
| 57 | } |
---|
| 58 | lappend result [lindex $dict [expr {$idx+1}]] |
---|
| 59 | } |
---|
| 60 | set result |
---|
| 61 | } {b d} |
---|
| 62 | test dict-2.4 {dict create command} { |
---|
| 63 | list [catch {dict create a} msg] $msg |
---|
| 64 | } {1 {wrong # args: should be "dict create ?key value ...?"}} |
---|
| 65 | test dict-2.5 {dict create command} { |
---|
| 66 | list [catch {dict create a b c} msg] $msg |
---|
| 67 | } {1 {wrong # args: should be "dict create ?key value ...?"}} |
---|
| 68 | test dict-2.6 {dict create command - initialse refcount field!} { |
---|
| 69 | # Bug 715751 will show up in memory debuggers like purify |
---|
| 70 | for {set i 0} {$i<10} {incr i} { |
---|
| 71 | set dictv [dict create a 0] |
---|
| 72 | set share [dict values $dictv] |
---|
| 73 | list [dict incr dictv a] |
---|
| 74 | } |
---|
| 75 | } {} |
---|
| 76 | test dict-2.7 {dict create command - #-quoting in string rep} { |
---|
| 77 | dict create # #comment |
---|
| 78 | } {{#} #comment} |
---|
| 79 | test dict-2.8 {dict create command - #-quoting in string rep} -body { |
---|
| 80 | dict create #a x #b x |
---|
| 81 | } -match glob -result {{#?} x #? x} |
---|
| 82 | |
---|
| 83 | test dict-3.1 {dict get command} {dict get {a b} a} b |
---|
| 84 | test dict-3.2 {dict get command} {dict get {a b c d} a} b |
---|
| 85 | test dict-3.3 {dict get command} {dict get {a b c d} c} d |
---|
| 86 | test dict-3.4 {dict get command} { |
---|
| 87 | list [catch {dict get {a b c d} b} msg] $msg |
---|
| 88 | } {1 {key "b" not known in dictionary}} |
---|
| 89 | test dict-3.5 {dict get command} {dict get {a {p q r s} b {u v x y}} a p} q |
---|
| 90 | test dict-3.6 {dict get command} {dict get {a {p q r s} b {u v x y}} a r} s |
---|
| 91 | test dict-3.7 {dict get command} {dict get {a {p q r s} b {u v x y}} b u} v |
---|
| 92 | test dict-3.8 {dict get command} {dict get {a {p q r s} b {u v x y}} b x} y |
---|
| 93 | test dict-3.9 {dict get command} { |
---|
| 94 | list [catch {dict get {a {p q r s} b {u v x y}} a z} msg] $msg |
---|
| 95 | } {1 {key "z" not known in dictionary}} |
---|
| 96 | test dict-3.10 {dict get command} { |
---|
| 97 | list [catch {dict get {a {p q r s} b {u v x y}} c z} msg] $msg |
---|
| 98 | } {1 {key "c" not known in dictionary}} |
---|
| 99 | test dict-3.11 {dict get command} {dict get [dict create a b c d] a} b |
---|
| 100 | test dict-3.12 {dict get command} { |
---|
| 101 | list [catch {dict get} msg] $msg |
---|
| 102 | } {1 {wrong # args: should be "dict get dictionary ?key key ...?"}} |
---|
| 103 | test dict-3.13 {dict get command} { |
---|
| 104 | set dict [dict get {a b c d}] |
---|
| 105 | if {$dict eq "a b c d"} { |
---|
| 106 | subst OK |
---|
| 107 | } elseif {$dict eq "c d a b"} { |
---|
| 108 | subst OK |
---|
| 109 | } else { |
---|
| 110 | set dict |
---|
| 111 | } |
---|
| 112 | } OK |
---|
| 113 | test dict-3.14 {dict get command} { |
---|
| 114 | list [catch {dict get {a b c d} a c} msg] $msg |
---|
| 115 | } {1 {missing value to go with key}} |
---|
| 116 | |
---|
| 117 | test dict-4.1 {dict replace command} { |
---|
| 118 | getOrder [dict replace {a b c d}] a c |
---|
| 119 | } {a b c d 2} |
---|
| 120 | test dict-4.2 {dict replace command} { |
---|
| 121 | getOrder [dict replace {a b c d} e f] a c e |
---|
| 122 | } {a b c d e f 3} |
---|
| 123 | test dict-4.3 {dict replace command} { |
---|
| 124 | getOrder [dict replace {a b c d} c f] a c |
---|
| 125 | } {a b c f 2} |
---|
| 126 | test dict-4.4 {dict replace command} { |
---|
| 127 | getOrder [dict replace {a b c d} c x a y] a c |
---|
| 128 | } {a y c x 2} |
---|
| 129 | test dict-4.5 {dict replace command} { |
---|
| 130 | list [catch {dict replace} msg] $msg |
---|
| 131 | } {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}} |
---|
| 132 | test dict-4.6 {dict replace command} { |
---|
| 133 | list [catch {dict replace {a a} a} msg] $msg |
---|
| 134 | } {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}} |
---|
| 135 | test dict-4.7 {dict replace command} { |
---|
| 136 | list [catch {dict replace {a a a} a b} msg] $msg |
---|
| 137 | } {1 {missing value to go with key}} |
---|
| 138 | test dict-4.8 {dict replace command} { |
---|
| 139 | list [catch {dict replace [list a a a] a b} msg] $msg |
---|
| 140 | } {1 {missing value to go with key}} |
---|
| 141 | test dict-4.9 {dict replace command} {dict replace [list a a] a b} {a b} |
---|
| 142 | test dict-4.10 {dict replace command} {dict replace [list a a] a b a c} {a c} |
---|
| 143 | |
---|
| 144 | test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d} |
---|
| 145 | test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b} |
---|
| 146 | test dict-5.3 {dict remove command} {dict remove {a b c d} a c} {} |
---|
| 147 | test dict-5.4 {dict remove command} {dict remove {a b c d} c a} {} |
---|
| 148 | test dict-5.5 {dict remove command} { |
---|
| 149 | getOrder [dict remove {a b c d}] a c |
---|
| 150 | } {a b c d 2} |
---|
| 151 | test dict-5.6 {dict remove command} {dict remove {a b} c} {a b} |
---|
| 152 | test dict-5.7 {dict remove command} { |
---|
| 153 | list [catch {dict remove} msg] $msg |
---|
| 154 | } {1 {wrong # args: should be "dict remove dictionary ?key ...?"}} |
---|
| 155 | |
---|
| 156 | test dict-6.1 {dict keys command} {dict keys {a b}} a |
---|
| 157 | test dict-6.2 {dict keys command} {dict keys {c d}} c |
---|
| 158 | test dict-6.3 {dict keys command} {lsort [dict keys {a b c d}]} {a c} |
---|
| 159 | test dict-6.4 {dict keys command} {dict keys {a b c d} a} a |
---|
| 160 | test dict-6.5 {dict keys command} {dict keys {a b c d} c} c |
---|
| 161 | test dict-6.6 {dict keys command} {dict keys {a b c d} e} {} |
---|
| 162 | test dict-6.7 {dict keys command} {lsort [dict keys {a b c d ca da} c*]} {c ca} |
---|
| 163 | test dict-6.8 {dict keys command} { |
---|
| 164 | list [catch {dict keys} msg] $msg |
---|
| 165 | } {1 {wrong # args: should be "dict keys dictionary ?pattern?"}} |
---|
| 166 | test dict-6.9 {dict keys command} { |
---|
| 167 | list [catch {dict keys {} a b} msg] $msg |
---|
| 168 | } {1 {wrong # args: should be "dict keys dictionary ?pattern?"}} |
---|
| 169 | test dict-6.10 {dict keys command} { |
---|
| 170 | list [catch {dict keys a} msg] $msg |
---|
| 171 | } {1 {missing value to go with key}} |
---|
| 172 | |
---|
| 173 | test dict-7.1 {dict values command} {dict values {a b}} b |
---|
| 174 | test dict-7.2 {dict values command} {dict values {c d}} d |
---|
| 175 | test dict-7.3 {dict values command} {lsort [dict values {a b c d}]} {b d} |
---|
| 176 | test dict-7.4 {dict values command} {dict values {a b c d} b} b |
---|
| 177 | test dict-7.5 {dict values command} {dict values {a b c d} d} d |
---|
| 178 | test dict-7.6 {dict values command} {dict values {a b c d} e} {} |
---|
| 179 | test dict-7.7 {dict values command} {lsort [dict values {a b c d ca da} d*]} {d da} |
---|
| 180 | test dict-7.8 {dict values command} { |
---|
| 181 | list [catch {dict values} msg] $msg |
---|
| 182 | } {1 {wrong # args: should be "dict values dictionary ?pattern?"}} |
---|
| 183 | test dict-7.9 {dict values command} { |
---|
| 184 | list [catch {dict values {} a b} msg] $msg |
---|
| 185 | } {1 {wrong # args: should be "dict values dictionary ?pattern?"}} |
---|
| 186 | test dict-7.10 {dict values command} { |
---|
| 187 | list [catch {dict values a} msg] $msg |
---|
| 188 | } {1 {missing value to go with key}} |
---|
| 189 | |
---|
| 190 | test dict-8.1 {dict size command} {dict size {}} 0 |
---|
| 191 | test dict-8.2 {dict size command} {dict size {a b}} 1 |
---|
| 192 | test dict-8.3 {dict size command} {dict size {a b c d}} 2 |
---|
| 193 | test dict-8.4 {dict size command} { |
---|
| 194 | list [catch {dict size} msg] $msg |
---|
| 195 | } {1 {wrong # args: should be "dict size dictionary"}} |
---|
| 196 | test dict-8.5 {dict size command} { |
---|
| 197 | list [catch {dict size a b} msg] $msg |
---|
| 198 | } {1 {wrong # args: should be "dict size dictionary"}} |
---|
| 199 | test dict-8.6 {dict size command} { |
---|
| 200 | list [catch {dict size a} msg] $msg |
---|
| 201 | } {1 {missing value to go with key}} |
---|
| 202 | |
---|
| 203 | test dict-9.1 {dict exists command} {dict exists {a b} a} 1 |
---|
| 204 | test dict-9.2 {dict exists command} {dict exists {a b} b} 0 |
---|
| 205 | test dict-9.3 {dict exists command} {dict exists {a {b c}} a b} 1 |
---|
| 206 | test dict-9.4 {dict exists command} {dict exists {a {b c}} a c} 0 |
---|
| 207 | test dict-9.5 {dict exists command} {dict exists {a {b c}} b c} 0 |
---|
| 208 | test dict-9.6 {dict exists command} { |
---|
| 209 | list [catch {dict exists {a {b c d}} a c} msg] $msg |
---|
| 210 | } {1 {missing value to go with key}} |
---|
| 211 | test dict-9.7 {dict exists command} { |
---|
| 212 | list [catch {dict exists} msg] $msg |
---|
| 213 | } {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}} |
---|
| 214 | test dict-9.8 {dict exists command} { |
---|
| 215 | list [catch {dict exists {}} msg] $msg |
---|
| 216 | } {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}} |
---|
| 217 | |
---|
| 218 | test dict-10.1 {dict info command} { |
---|
| 219 | # Actual string returned by this command is undefined; it is |
---|
| 220 | # intended for human consumption and not for use by scripts. |
---|
| 221 | dict info {} |
---|
| 222 | subst {} |
---|
| 223 | } {} |
---|
| 224 | test dict-10.2 {dict info command} { |
---|
| 225 | list [catch {dict info} msg] $msg |
---|
| 226 | } {1 {wrong # args: should be "dict info dictionary"}} |
---|
| 227 | test dict-10.3 {dict info command} { |
---|
| 228 | list [catch {dict info {} x} msg] $msg |
---|
| 229 | } {1 {wrong # args: should be "dict info dictionary"}} |
---|
| 230 | test dict-10.4 {dict info command} { |
---|
| 231 | list [catch {dict info x} msg] $msg |
---|
| 232 | } {1 {missing value to go with key}} |
---|
| 233 | |
---|
| 234 | test dict-11.1 {dict incr command: unshared value} { |
---|
| 235 | set dictv [dict create \ |
---|
| 236 | a [string index "=0=" 1] \ |
---|
| 237 | b [expr {1+2}] \ |
---|
| 238 | c [expr {wide(0x80000000)+1}]] |
---|
| 239 | getOrder [dict incr dictv a] a b c |
---|
| 240 | } {a 1 b 3 c 2147483649 3} |
---|
| 241 | test dict-11.2 {dict incr command: unshared value} { |
---|
| 242 | set dictv [dict create \ |
---|
| 243 | a [string index "=0=" 1] \ |
---|
| 244 | b [expr {1+2}] \ |
---|
| 245 | c [expr {wide(0x80000000)+1}]] |
---|
| 246 | getOrder [dict incr dictv b] a b c |
---|
| 247 | } {a 0 b 4 c 2147483649 3} |
---|
| 248 | test dict-11.3 {dict incr command: unshared value} { |
---|
| 249 | set dictv [dict create \ |
---|
| 250 | a [string index "=0=" 1] \ |
---|
| 251 | b [expr {1+2}] \ |
---|
| 252 | c [expr {wide(0x80000000)+1}]] |
---|
| 253 | getOrder [dict incr dictv c] a b c |
---|
| 254 | } {a 0 b 3 c 2147483650 3} |
---|
| 255 | test dict-11.4 {dict incr command: shared value} { |
---|
| 256 | set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]] |
---|
| 257 | set sharing [dict values $dictv] |
---|
| 258 | getOrder [dict incr dictv a] a b c |
---|
| 259 | } {a 1 b 3 c 2147483649 3} |
---|
| 260 | test dict-11.5 {dict incr command: shared value} { |
---|
| 261 | set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]] |
---|
| 262 | set sharing [dict values $dictv] |
---|
| 263 | getOrder [dict incr dictv b] a b c |
---|
| 264 | } {a 0 b 4 c 2147483649 3} |
---|
| 265 | test dict-11.6 {dict incr command: shared value} { |
---|
| 266 | set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]] |
---|
| 267 | set sharing [dict values $dictv] |
---|
| 268 | getOrder [dict incr dictv c] a b c |
---|
| 269 | } {a 0 b 3 c 2147483650 3} |
---|
| 270 | test dict-11.7 {dict incr command: unknown values} { |
---|
| 271 | set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]] |
---|
| 272 | getOrder [dict incr dictv d] a b c d |
---|
| 273 | } {a 0 b 3 c 2147483649 d 1 4} |
---|
| 274 | test dict-11.8 {dict incr command} { |
---|
| 275 | set dictv {a 1} |
---|
| 276 | dict incr dictv a 2 |
---|
| 277 | } {a 3} |
---|
| 278 | test dict-11.9 {dict incr command} { |
---|
| 279 | set dictv {a dummy} |
---|
| 280 | list [catch {dict incr dictv a} msg] $msg |
---|
| 281 | } {1 {expected integer but got "dummy"}} |
---|
| 282 | test dict-11.10 {dict incr command} { |
---|
| 283 | set dictv {a 1} |
---|
| 284 | list [catch {dict incr dictv a dummy} msg] $msg |
---|
| 285 | } {1 {expected integer but got "dummy"}} |
---|
| 286 | test dict-11.11 {dict incr command} { |
---|
| 287 | catch {unset dictv} |
---|
| 288 | dict incr dictv a |
---|
| 289 | } {a 1} |
---|
| 290 | test dict-11.12 {dict incr command} { |
---|
| 291 | set dictv a |
---|
| 292 | list [catch {dict incr dictv a} msg] $msg |
---|
| 293 | } {1 {missing value to go with key}} |
---|
| 294 | test dict-11.13 {dict incr command} { |
---|
| 295 | set dictv a |
---|
| 296 | list [catch {dict incr dictv a a a} msg] $msg |
---|
| 297 | } {1 {wrong # args: should be "dict incr varName key ?increment?"}} |
---|
| 298 | test dict-11.14 {dict incr command} { |
---|
| 299 | set dictv a |
---|
| 300 | list [catch {dict incr dictv} msg] $msg |
---|
| 301 | } {1 {wrong # args: should be "dict incr varName key ?increment?"}} |
---|
| 302 | test dict-11.15 {dict incr command: write failure} { |
---|
| 303 | catch {unset dictVar} |
---|
| 304 | set dictVar(block) {} |
---|
| 305 | set result [list [catch {dict incr dictVar a} msg] $msg] |
---|
| 306 | catch {unset dictVar} |
---|
| 307 | set result |
---|
| 308 | } {1 {can't set "dictVar": variable is array}} |
---|
| 309 | test dict-11.16 {dict incr command: compilation} { |
---|
| 310 | proc dicttest {} { |
---|
| 311 | set v {a 0 b 0 c 0} |
---|
| 312 | dict incr v a |
---|
| 313 | dict incr v b 1 |
---|
| 314 | dict incr v c 2 |
---|
| 315 | dict incr v d 3 |
---|
| 316 | list [dict get $v a] [dict get $v b] [dict get $v c] [dict get $v d] |
---|
| 317 | } |
---|
| 318 | dicttest |
---|
| 319 | } {1 1 2 3} |
---|
| 320 | test dict-11.17 {dict incr command: compilation} { |
---|
| 321 | proc dicttest {} { |
---|
| 322 | set dictv {a 1} |
---|
| 323 | dict incr dictv a 2 |
---|
| 324 | } |
---|
| 325 | dicttest |
---|
| 326 | } {a 3} |
---|
| 327 | |
---|
| 328 | test dict-12.1 {dict lappend command} { |
---|
| 329 | set dictv {a a} |
---|
| 330 | dict lappend dictv a |
---|
| 331 | } {a a} |
---|
| 332 | test dict-12.2 {dict lappend command} { |
---|
| 333 | set dictv {a a} |
---|
| 334 | set sharing [dict values $dictv] |
---|
| 335 | dict lappend dictv a b |
---|
| 336 | } {a {a b}} |
---|
| 337 | test dict-12.3 {dict lappend command} { |
---|
| 338 | set dictv {a a} |
---|
| 339 | dict lappend dictv a b c |
---|
| 340 | } {a {a b c}} |
---|
| 341 | test dict-12.2.1 {dict lappend command} { |
---|
| 342 | set dictv [dict create a [string index =a= 1]] |
---|
| 343 | dict lappend dictv a b |
---|
| 344 | } {a {a b}} |
---|
| 345 | test dict-12.4 {dict lappend command} { |
---|
| 346 | set dictv {} |
---|
| 347 | dict lappend dictv a x y z |
---|
| 348 | } {a {x y z}} |
---|
| 349 | test dict-12.5 {dict lappend command} { |
---|
| 350 | catch {unset dictv} |
---|
| 351 | dict lappend dictv a b |
---|
| 352 | } {a b} |
---|
| 353 | test dict-12.6 {dict lappend command} { |
---|
| 354 | set dictv a |
---|
| 355 | list [catch {dict lappend dictv a a} msg] $msg |
---|
| 356 | } {1 {missing value to go with key}} |
---|
| 357 | test dict-12.7 {dict lappend command} { |
---|
| 358 | list [catch {dict lappend} msg] $msg |
---|
| 359 | } {1 {wrong # args: should be "dict lappend varName key ?value ...?"}} |
---|
| 360 | test dict-12.8 {dict lappend command} { |
---|
| 361 | list [catch {dict lappend dictv} msg] $msg |
---|
| 362 | } {1 {wrong # args: should be "dict lappend varName key ?value ...?"}} |
---|
| 363 | test dict-12.9 {dict lappend command} { |
---|
| 364 | set dictv [dict create a "\{"] |
---|
| 365 | list [catch {dict lappend dictv a a} msg] $msg |
---|
| 366 | } {1 {unmatched open brace in list}} |
---|
| 367 | test dict-12.10 {dict lappend command: write failure} { |
---|
| 368 | catch {unset dictVar} |
---|
| 369 | set dictVar(block) {} |
---|
| 370 | set result [list [catch {dict lappend dictVar a x} msg] $msg] |
---|
| 371 | catch {unset dictVar} |
---|
| 372 | set result |
---|
| 373 | } {1 {can't set "dictVar": variable is array}} |
---|
| 374 | |
---|
| 375 | test dict-13.1 {dict append command} { |
---|
| 376 | set dictv {a a} |
---|
| 377 | dict append dictv a |
---|
| 378 | } {a a} |
---|
| 379 | test dict-13.2 {dict append command} { |
---|
| 380 | set dictv {a a} |
---|
| 381 | set sharing [dict values $dictv] |
---|
| 382 | dict append dictv a b |
---|
| 383 | } {a ab} |
---|
| 384 | test dict-13.3 {dict append command} { |
---|
| 385 | set dictv {a a} |
---|
| 386 | dict append dictv a b c |
---|
| 387 | } {a abc} |
---|
| 388 | test dict-13.2.1 {dict append command} { |
---|
| 389 | set dictv [dict create a [string index =a= 1]] |
---|
| 390 | dict append dictv a b |
---|
| 391 | } {a ab} |
---|
| 392 | test dict-13.4 {dict append command} { |
---|
| 393 | set dictv {} |
---|
| 394 | dict append dictv a x y z |
---|
| 395 | } {a xyz} |
---|
| 396 | test dict-13.5 {dict append command} { |
---|
| 397 | catch {unset dictv} |
---|
| 398 | dict append dictv a b |
---|
| 399 | } {a b} |
---|
| 400 | test dict-13.6 {dict append command} { |
---|
| 401 | set dictv a |
---|
| 402 | list [catch {dict append dictv a a} msg] $msg |
---|
| 403 | } {1 {missing value to go with key}} |
---|
| 404 | test dict-13.7 {dict append command} { |
---|
| 405 | list [catch {dict append} msg] $msg |
---|
| 406 | } {1 {wrong # args: should be "dict append varName key ?value ...?"}} |
---|
| 407 | test dict-13.8 {dict append command} { |
---|
| 408 | list [catch {dict append dictv} msg] $msg |
---|
| 409 | } {1 {wrong # args: should be "dict append varName key ?value ...?"}} |
---|
| 410 | test dict-13.9 {dict append command: write failure} { |
---|
| 411 | catch {unset dictVar} |
---|
| 412 | set dictVar(block) {} |
---|
| 413 | set result [list [catch {dict append dictVar a x} msg] $msg] |
---|
| 414 | catch {unset dictVar} |
---|
| 415 | set result |
---|
| 416 | } {1 {can't set "dictVar": variable is array}} |
---|
| 417 | |
---|
| 418 | test dict-14.1 {dict for command: syntax} { |
---|
| 419 | list [catch {dict for} msg] $msg |
---|
| 420 | } {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}} |
---|
| 421 | test dict-14.2 {dict for command: syntax} { |
---|
| 422 | list [catch {dict for x} msg] $msg |
---|
| 423 | } {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}} |
---|
| 424 | test dict-14.3 {dict for command: syntax} { |
---|
| 425 | list [catch {dict for x x} msg] $msg |
---|
| 426 | } {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}} |
---|
| 427 | test dict-14.4 {dict for command: syntax} { |
---|
| 428 | list [catch {dict for x x x x} msg] $msg |
---|
| 429 | } {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}} |
---|
| 430 | test dict-14.5 {dict for command: syntax} { |
---|
| 431 | list [catch {dict for x x x} msg] $msg |
---|
| 432 | } {1 {must have exactly two variable names}} |
---|
| 433 | test dict-14.6 {dict for command: syntax} { |
---|
| 434 | list [catch {dict for {x x x} x x} msg] $msg |
---|
| 435 | } {1 {must have exactly two variable names}} |
---|
| 436 | test dict-14.7 {dict for command: syntax} { |
---|
| 437 | list [catch {dict for "\{x" x x} msg] $msg |
---|
| 438 | } {1 {unmatched open brace in list}} |
---|
| 439 | test dict-14.8 {dict for command} { |
---|
| 440 | # This test confirms that [dict keys], [dict values] and [dict for] |
---|
| 441 | # all traverse a dictionary in the same order. |
---|
| 442 | set dictv {a A b B c C} |
---|
| 443 | set keys {} |
---|
| 444 | set values {} |
---|
| 445 | dict for {k v} $dictv { |
---|
| 446 | lappend keys $k |
---|
| 447 | lappend values $v |
---|
| 448 | } |
---|
| 449 | set result [expr { |
---|
| 450 | $keys eq [dict keys $dictv] && $values eq [dict values $dictv] |
---|
| 451 | }] |
---|
| 452 | expr {$result ? "YES" : [list "NO" $dictv $keys $values]} |
---|
| 453 | } YES |
---|
| 454 | test dict-14.9 {dict for command} { |
---|
| 455 | dict for {k v} {} { |
---|
| 456 | error "unexpected execution of 'dict for' body" |
---|
| 457 | } |
---|
| 458 | } {} |
---|
| 459 | test dict-14.10 {dict for command: script results} { |
---|
| 460 | set times 0 |
---|
| 461 | dict for {k v} {a a b b} { |
---|
| 462 | incr times |
---|
| 463 | continue |
---|
| 464 | error "shouldn't get here" |
---|
| 465 | } |
---|
| 466 | set times |
---|
| 467 | } 2 |
---|
| 468 | test dict-14.11 {dict for command: script results} { |
---|
| 469 | set times 0 |
---|
| 470 | dict for {k v} {a a b b} { |
---|
| 471 | incr times |
---|
| 472 | break |
---|
| 473 | error "shouldn't get here" |
---|
| 474 | } |
---|
| 475 | set times |
---|
| 476 | } 1 |
---|
| 477 | test dict-14.12 {dict for command: script results} { |
---|
| 478 | set times 0 |
---|
| 479 | list [catch { |
---|
| 480 | dict for {k v} {a a b b} { |
---|
| 481 | incr times |
---|
| 482 | error test |
---|
| 483 | } |
---|
| 484 | } msg] $msg $times $::errorInfo |
---|
| 485 | } {1 test 1 {test |
---|
| 486 | while executing |
---|
| 487 | "error test" |
---|
| 488 | ("dict for" body line 3) |
---|
| 489 | invoked from within |
---|
| 490 | "dict for {k v} {a a b b} { |
---|
| 491 | incr times |
---|
| 492 | error test |
---|
| 493 | }"}} |
---|
| 494 | test dict-14.13 {dict for command: script results} { |
---|
| 495 | proc dicttest {} { |
---|
| 496 | rename dicttest {} |
---|
| 497 | dict for {k v} {a b} { |
---|
| 498 | return ok,$k,$v |
---|
| 499 | error "skipped return completely" |
---|
| 500 | } |
---|
| 501 | error "return didn't go far enough" |
---|
| 502 | } |
---|
| 503 | dicttest |
---|
| 504 | } ok,a,b |
---|
| 505 | test dict-14.14 {dict for command: handle representation loss} { |
---|
| 506 | set dictVar {a b c d e f g h} |
---|
| 507 | set keys {} |
---|
| 508 | set values {} |
---|
| 509 | dict for {k v} $dictVar { |
---|
| 510 | if {[llength $dictVar]} { |
---|
| 511 | lappend keys $k |
---|
| 512 | lappend values $v |
---|
| 513 | } |
---|
| 514 | } |
---|
| 515 | list [lsort $keys] [lsort $values] |
---|
| 516 | } {{a c e g} {b d f h}} |
---|
| 517 | test dict-14.15 {dict for command: keys are unique and iterated over once only} { |
---|
| 518 | set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} |
---|
| 519 | catch {unset accum} |
---|
| 520 | array set accum {} |
---|
| 521 | dict for {k v} $dictVar { |
---|
| 522 | append accum($k) $v, |
---|
| 523 | } |
---|
| 524 | set result [lsort [array names accum]] |
---|
| 525 | lappend result : |
---|
| 526 | foreach k $result { |
---|
| 527 | catch {lappend result $accum($k)} |
---|
| 528 | } |
---|
| 529 | catch {unset accum} |
---|
| 530 | set result |
---|
| 531 | } {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,} |
---|
| 532 | test dict-14.16 {dict for command in compilation context} { |
---|
| 533 | proc dicttest {} { |
---|
| 534 | set res {x x x x x x} |
---|
| 535 | dict for {k v} {a 0 b 1 c 2 d 3 e 4 f 5} { |
---|
| 536 | lset res $v $k |
---|
| 537 | continue |
---|
| 538 | } |
---|
| 539 | return $res |
---|
| 540 | } |
---|
| 541 | dicttest |
---|
| 542 | } {a b c d e f} |
---|
| 543 | test dict-14.17 {dict for command in compilation context} { |
---|
| 544 | # Bug 1379349 |
---|
| 545 | proc dicttest {} { |
---|
| 546 | set d [dict create a 1] ;# Dict must be unshared! |
---|
| 547 | dict for {k v} $d { |
---|
| 548 | dict set d $k 0 ;# Any modification will do |
---|
| 549 | } |
---|
| 550 | return $d |
---|
| 551 | } |
---|
| 552 | dicttest |
---|
| 553 | } {a 0} |
---|
| 554 | test dict-14.18 {dict for command in compilation context} { |
---|
| 555 | # Bug 1382528 |
---|
| 556 | proc dicttest {} { |
---|
| 557 | dict for {k v} {} {} ;# Note empty dict |
---|
| 558 | catch { error foo } ;# Note compiled [catch] |
---|
| 559 | } |
---|
| 560 | dicttest |
---|
| 561 | } 1 |
---|
| 562 | test dict-14.19 {dict for and invalid dicts: bug 1531184} -body { |
---|
| 563 | di[list]ct for {k v} x {} |
---|
| 564 | } -returnCodes 1 -result {missing value to go with key} |
---|
| 565 | test dict-14.20 {dict for stack space compilation: bug 1903325} { |
---|
| 566 | proc dicttest {x y args} { |
---|
| 567 | dict for {a b} $x {} |
---|
| 568 | concat "c=$y,$args" |
---|
| 569 | } |
---|
| 570 | dicttest {} 1 2 3 |
---|
| 571 | } {c=1,2 3} |
---|
| 572 | # There's probably a lot more tests to add here. Really ought to use a |
---|
| 573 | # coverage tool for this job... |
---|
| 574 | |
---|
| 575 | test dict-15.1 {dict set command} { |
---|
| 576 | set dictVar {} |
---|
| 577 | dict set dictVar a x |
---|
| 578 | } {a x} |
---|
| 579 | test dict-15.2 {dict set command} { |
---|
| 580 | set dictvar {a {}} |
---|
| 581 | dict set dictvar a b x |
---|
| 582 | } {a {b x}} |
---|
| 583 | test dict-15.3 {dict set command} { |
---|
| 584 | set dictvar {a {b {}}} |
---|
| 585 | dict set dictvar a b c x |
---|
| 586 | } {a {b {c x}}} |
---|
| 587 | test dict-15.4 {dict set command} { |
---|
| 588 | set dictVar {a y} |
---|
| 589 | dict set dictVar a x |
---|
| 590 | } {a x} |
---|
| 591 | test dict-15.5 {dict set command} { |
---|
| 592 | set dictVar {a {b y}} |
---|
| 593 | dict set dictVar a b x |
---|
| 594 | } {a {b x}} |
---|
| 595 | test dict-15.6 {dict set command} { |
---|
| 596 | set dictVar {a {b {c y}}} |
---|
| 597 | dict set dictVar a b c x |
---|
| 598 | } {a {b {c x}}} |
---|
| 599 | test dict-15.7 {dict set command: path creation} { |
---|
| 600 | set dictVar {} |
---|
| 601 | dict set dictVar a b x |
---|
| 602 | } {a {b x}} |
---|
| 603 | test dict-15.8 {dict set command: creates variables} { |
---|
| 604 | catch {unset dictVar} |
---|
| 605 | dict set dictVar a x |
---|
| 606 | set dictVar |
---|
| 607 | } {a x} |
---|
| 608 | test dict-15.9 {dict set command: write failure} { |
---|
| 609 | catch {unset dictVar} |
---|
| 610 | set dictVar(block) {} |
---|
| 611 | set result [list [catch {dict set dictVar a x} msg] $msg] |
---|
| 612 | catch {unset dictVar} |
---|
| 613 | set result |
---|
| 614 | } {1 {can't set "dictVar": variable is array}} |
---|
| 615 | test dict-15.10 {dict set command: syntax} { |
---|
| 616 | list [catch {dict set} msg] $msg |
---|
| 617 | } {1 {wrong # args: should be "dict set varName key ?key ...? value"}} |
---|
| 618 | test dict-15.11 {dict set command: syntax} { |
---|
| 619 | list [catch {dict set a} msg] $msg |
---|
| 620 | } {1 {wrong # args: should be "dict set varName key ?key ...? value"}} |
---|
| 621 | test dict-15.12 {dict set command: syntax} { |
---|
| 622 | list [catch {dict set a a} msg] $msg |
---|
| 623 | } {1 {wrong # args: should be "dict set varName key ?key ...? value"}} |
---|
| 624 | test dict-15.13 {dict set command} { |
---|
| 625 | set dictVar a |
---|
| 626 | list [catch {dict set dictVar b c} msg] $msg |
---|
| 627 | } {1 {missing value to go with key}} |
---|
| 628 | |
---|
| 629 | test dict-16.1 {dict unset command} { |
---|
| 630 | set dictVar {a b c d} |
---|
| 631 | dict unset dictVar a |
---|
| 632 | } {c d} |
---|
| 633 | test dict-16.2 {dict unset command} { |
---|
| 634 | set dictVar {a b c d} |
---|
| 635 | dict unset dictVar c |
---|
| 636 | } {a b} |
---|
| 637 | test dict-16.3 {dict unset command} { |
---|
| 638 | set dictVar {a b} |
---|
| 639 | dict unset dictVar c |
---|
| 640 | } {a b} |
---|
| 641 | test dict-16.4 {dict unset command} { |
---|
| 642 | set dictVar {a {b c d e}} |
---|
| 643 | dict unset dictVar a b |
---|
| 644 | } {a {d e}} |
---|
| 645 | test dict-16.5 {dict unset command} { |
---|
| 646 | set dictVar a |
---|
| 647 | list [catch {dict unset dictVar a} msg] $msg |
---|
| 648 | } {1 {missing value to go with key}} |
---|
| 649 | test dict-16.6 {dict unset command} { |
---|
| 650 | set dictVar {a b} |
---|
| 651 | list [catch {dict unset dictVar c d} msg] $msg |
---|
| 652 | } {1 {key "c" not known in dictionary}} |
---|
| 653 | test dict-16.7 {dict unset command} { |
---|
| 654 | catch {unset dictVar} |
---|
| 655 | list [info exists dictVar] [dict unset dictVar a] [info exists dictVar] |
---|
| 656 | } {0 {} 1} |
---|
| 657 | test dict-16.8 {dict unset command} { |
---|
| 658 | list [catch {dict unset dictVar} msg] $msg |
---|
| 659 | } {1 {wrong # args: should be "dict unset varName key ?key ...?"}} |
---|
| 660 | test dict-16.9 {dict unset command: write failure} { |
---|
| 661 | catch {unset dictVar} |
---|
| 662 | set dictVar(block) {} |
---|
| 663 | set result [list [catch {dict unset dictVar a} msg] $msg] |
---|
| 664 | catch {unset dictVar} |
---|
| 665 | set result |
---|
| 666 | } {1 {can't set "dictVar": variable is array}} |
---|
| 667 | |
---|
| 668 | test dict-17.1 {dict filter command: key} { |
---|
| 669 | set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} |
---|
| 670 | dict filter $dictVar key a2 |
---|
| 671 | } {a2 b} |
---|
| 672 | test dict-17.2 {dict filter command: key} { |
---|
| 673 | set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} |
---|
| 674 | dict size [dict filter $dictVar key *] |
---|
| 675 | } 6 |
---|
| 676 | test dict-17.3 {dict filter command: key} { |
---|
| 677 | set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} |
---|
| 678 | getOrder [dict filter $dictVar key ???] bar foo |
---|
| 679 | } {bar foo foo bar 2} |
---|
| 680 | test dict-17.4 {dict filter command: key} { |
---|
| 681 | list [catch {dict filter {} key} msg] $msg |
---|
| 682 | } {1 {wrong # args: should be "dict filter dictionary key globPattern"}} |
---|
| 683 | test dict-17.5 {dict filter command: key} { |
---|
| 684 | list [catch {dict filter {} key a a} msg] $msg |
---|
| 685 | } {1 {wrong # args: should be "dict filter dictionary key globPattern"}} |
---|
| 686 | test dict-17.6 {dict filter command: value} { |
---|
| 687 | set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} |
---|
| 688 | dict filter $dictVar value c |
---|
| 689 | } {b1 c} |
---|
| 690 | test dict-17.7 {dict filter command: value} { |
---|
| 691 | set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} |
---|
| 692 | dict size [dict filter $dictVar value *] |
---|
| 693 | } 6 |
---|
| 694 | test dict-17.8 {dict filter command: value} { |
---|
| 695 | set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} |
---|
| 696 | getOrder [dict filter $dictVar value ???] bar foo |
---|
| 697 | } {bar foo foo bar 2} |
---|
| 698 | test dict-17.9 {dict filter command: value} { |
---|
| 699 | list [catch {dict filter {} value} msg] $msg |
---|
| 700 | } {1 {wrong # args: should be "dict filter dictionary value globPattern"}} |
---|
| 701 | test dict-17.10 {dict filter command: value} { |
---|
| 702 | list [catch {dict filter {} value a a} msg] $msg |
---|
| 703 | } {1 {wrong # args: should be "dict filter dictionary value globPattern"}} |
---|
| 704 | test dict-17.11 {dict filter command: script} { |
---|
| 705 | set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} |
---|
| 706 | set n 0 |
---|
| 707 | list [getOrder [dict filter $dictVar script {k v} { |
---|
| 708 | incr n |
---|
| 709 | expr {[string length $k] == [string length $v]} |
---|
| 710 | }] bar foo] $n |
---|
| 711 | } {{bar foo foo bar 2} 6} |
---|
| 712 | test dict-17.12 {dict filter command: script} { |
---|
| 713 | list [catch {dict filter {a b} script {k v} {concat $k $v}} msg] $msg |
---|
| 714 | } {1 {expected boolean value but got "a b"}} |
---|
| 715 | test dict-17.13 {dict filter command: script} { |
---|
| 716 | list [catch {dict filter {a b} script {k v} {error x}} msg] $msg \ |
---|
| 717 | $::errorInfo |
---|
| 718 | } {1 x {x |
---|
| 719 | while executing |
---|
| 720 | "error x" |
---|
| 721 | ("dict filter" script line 1) |
---|
| 722 | invoked from within |
---|
| 723 | "dict filter {a b} script {k v} {error x}"}} |
---|
| 724 | test dict-17.14 {dict filter command: script} { |
---|
| 725 | set n 0 |
---|
| 726 | list [dict filter {a b c d} script {k v} { |
---|
| 727 | incr n |
---|
| 728 | break |
---|
| 729 | error boom! |
---|
| 730 | }] $n |
---|
| 731 | } {{} 1} |
---|
| 732 | test dict-17.15 {dict filter command: script} { |
---|
| 733 | set n 0 |
---|
| 734 | list [dict filter {a b c d} script {k v} { |
---|
| 735 | incr n |
---|
| 736 | continue |
---|
| 737 | error boom! |
---|
| 738 | }] $n |
---|
| 739 | } {{} 2} |
---|
| 740 | test dict-17.16 {dict filter command: script} { |
---|
| 741 | proc dicttest {} { |
---|
| 742 | rename dicttest {} |
---|
| 743 | dict filter {a b} script {k v} { |
---|
| 744 | return ok,$k,$v |
---|
| 745 | error "skipped return completely" |
---|
| 746 | } |
---|
| 747 | error "return didn't go far enough" |
---|
| 748 | } |
---|
| 749 | dicttest |
---|
| 750 | } ok,a,b |
---|
| 751 | test dict-17.17 {dict filter command: script} { |
---|
| 752 | dict filter {a b} script {k k} {continue} |
---|
| 753 | set k |
---|
| 754 | } b |
---|
| 755 | test dict-17.18 {dict filter command: script} { |
---|
| 756 | list [catch {dict filter {a b} script {k k}} msg] $msg |
---|
| 757 | } {1 {wrong # args: should be "dict filter dictionary script {keyVar valueVar} filterScript"}} |
---|
| 758 | test dict-17.19 {dict filter command: script} { |
---|
| 759 | list [catch {dict filter {a b} script k {continue}} msg] $msg |
---|
| 760 | } {1 {must have exactly two variable names}} |
---|
| 761 | test dict-17.20 {dict filter command: script} { |
---|
| 762 | list [catch {dict filter {a b} script "\{k v" {continue}} msg] $msg |
---|
| 763 | } {1 {unmatched open brace in list}} |
---|
| 764 | test dict-17.21 {dict filter command} { |
---|
| 765 | list [catch {dict filter {a b}} msg] $msg |
---|
| 766 | } {1 {wrong # args: should be "dict filter dictionary filterType ..."}} |
---|
| 767 | test dict-17.22 {dict filter command} { |
---|
| 768 | list [catch {dict filter {a b} JUNK} msg] $msg |
---|
| 769 | } {1 {bad filterType "JUNK": must be key, script, or value}} |
---|
| 770 | test dict-17.23 {dict filter command} { |
---|
| 771 | list [catch {dict filter a key *} msg] $msg |
---|
| 772 | } {1 {missing value to go with key}} |
---|
| 773 | |
---|
| 774 | test dict-18.1 {dict-list relationship} { |
---|
| 775 | -body { |
---|
| 776 | # Test that any internal conversion between list and dict |
---|
| 777 | # does not change the object |
---|
| 778 | set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y] |
---|
| 779 | dict values $l |
---|
| 780 | set l |
---|
| 781 | } |
---|
| 782 | -result {1 2 3 4 5 6 7 8 9 0 q w e r t y} |
---|
| 783 | } |
---|
| 784 | test dict-18.2 {dict-list relationship} { |
---|
| 785 | -body { |
---|
| 786 | # Test that the dictionary is a valid list |
---|
| 787 | set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2] |
---|
| 788 | for {set t 0} {$t < 5} {incr t} { |
---|
| 789 | llength $d |
---|
| 790 | dict lappend d "abc def" "\}\{" |
---|
| 791 | dict append d "a\{b" "\}" |
---|
| 792 | dict incr d "c\}d" 1 |
---|
| 793 | } |
---|
| 794 | llength $d |
---|
| 795 | } |
---|
| 796 | -result 6 |
---|
| 797 | } |
---|
| 798 | |
---|
| 799 | # This is a test for a specific bug. |
---|
| 800 | # It shows a bad ref counter when running with memdebug on. |
---|
| 801 | test dict-19.1 {memory bug} -setup { |
---|
| 802 | proc xxx {} { |
---|
| 803 | set successors [dict create x {c d}] |
---|
| 804 | dict set successors x a b |
---|
| 805 | dict get $successors x |
---|
| 806 | } |
---|
| 807 | } -body { |
---|
| 808 | xxx |
---|
| 809 | } -cleanup { |
---|
| 810 | rename xxx {} |
---|
| 811 | } -result [dict create c d a b] |
---|
| 812 | test dict-19.2 {dict: testing for leaks} -setup { |
---|
| 813 | proc getbytes {} { |
---|
| 814 | set lines [split [memory info] "\n"] |
---|
| 815 | lindex [lindex $lines 3] 3 |
---|
| 816 | } |
---|
| 817 | # This test is made to stress object reference management |
---|
| 818 | proc stress {} { |
---|
| 819 | # A shared invalid dictinary |
---|
| 820 | set apa {a {}b c d} |
---|
| 821 | set bepa $apa |
---|
| 822 | catch {dict replace $apa e f} |
---|
| 823 | catch {dict remove $apa c d} |
---|
| 824 | catch {dict incr apa a 5} |
---|
| 825 | catch {dict lappend apa a 5} |
---|
| 826 | catch {dict append apa a 5} |
---|
| 827 | catch {dict set apa a 5} |
---|
| 828 | catch {dict unset apa a} |
---|
| 829 | |
---|
| 830 | # A shared valid dictionary, invalid incr |
---|
| 831 | set apa {a b c d} |
---|
| 832 | set bepa $apa |
---|
| 833 | catch {dict incr bepa a 5} |
---|
| 834 | |
---|
| 835 | # An error during write to an unshared object, incr |
---|
| 836 | set apa {a 1 b 2} |
---|
| 837 | set bepa [lrange $apa 0 end] |
---|
| 838 | trace add variable bepa write {error hej} |
---|
| 839 | catch {dict incr bepa a 5} |
---|
| 840 | trace remove variable bepa write {error hej} |
---|
| 841 | unset bepa |
---|
| 842 | |
---|
| 843 | # An error during write to a shared object, incr |
---|
| 844 | set apa {a 1 b 2} |
---|
| 845 | set bepa $apa |
---|
| 846 | trace add variable bepa write {error hej} |
---|
| 847 | catch {dict incr bepa a 5} |
---|
| 848 | trace remove variable bepa write {error hej} |
---|
| 849 | unset bepa |
---|
| 850 | |
---|
| 851 | # A shared valid dictionary, invalid lappend |
---|
| 852 | set apa [list a {{}b} c d] |
---|
| 853 | set bepa $apa |
---|
| 854 | catch {dict lappend bepa a 5} |
---|
| 855 | |
---|
| 856 | # An error during write to an unshared object, lappend |
---|
| 857 | set apa {a 1 b 2} |
---|
| 858 | set bepa [lrange $apa 0 end] |
---|
| 859 | trace add variable bepa write {error hej} |
---|
| 860 | catch {dict lappend bepa a 5} |
---|
| 861 | trace remove variable bepa write {error hej} |
---|
| 862 | unset bepa |
---|
| 863 | |
---|
| 864 | # An error during write to a shared object, lappend |
---|
| 865 | set apa {a 1 b 2} |
---|
| 866 | set bepa $apa |
---|
| 867 | trace add variable bepa write {error hej} |
---|
| 868 | catch {dict lappend bepa a 5} |
---|
| 869 | trace remove variable bepa write {error hej} |
---|
| 870 | unset bepa |
---|
| 871 | |
---|
| 872 | # An error during write to an unshared object, append |
---|
| 873 | set apa {a 1 b 2} |
---|
| 874 | set bepa [lrange $apa 0 end] |
---|
| 875 | trace add variable bepa write {error hej} |
---|
| 876 | catch {dict append bepa a 5} |
---|
| 877 | trace remove variable bepa write {error hej} |
---|
| 878 | unset bepa |
---|
| 879 | |
---|
| 880 | # An error during write to a shared object, append |
---|
| 881 | set apa {a 1 b 2} |
---|
| 882 | set bepa $apa |
---|
| 883 | trace add variable bepa write {error hej} |
---|
| 884 | catch {dict append bepa a 5} |
---|
| 885 | trace remove variable bepa write {error hej} |
---|
| 886 | unset bepa |
---|
| 887 | |
---|
| 888 | # An error during write to an unshared object, set |
---|
| 889 | set apa {a 1 b 2} |
---|
| 890 | set bepa [lrange $apa 0 end] |
---|
| 891 | trace add variable bepa write {error hej} |
---|
| 892 | catch {dict set bepa a 5} |
---|
| 893 | trace remove variable bepa write {error hej} |
---|
| 894 | unset bepa |
---|
| 895 | |
---|
| 896 | # An error during write to a shared object, set |
---|
| 897 | set apa {a 1 b 2} |
---|
| 898 | set bepa $apa |
---|
| 899 | trace add variable bepa write {error hej} |
---|
| 900 | catch {dict set bepa a 5} |
---|
| 901 | trace remove variable bepa write {error hej} |
---|
| 902 | unset bepa |
---|
| 903 | |
---|
| 904 | # An error during write to an unshared object, unset |
---|
| 905 | set apa {a 1 b 2} |
---|
| 906 | set bepa [lrange $apa 0 end] |
---|
| 907 | trace add variable bepa write {error hej} |
---|
| 908 | catch {dict unset bepa a} |
---|
| 909 | trace remove variable bepa write {error hej} |
---|
| 910 | unset bepa |
---|
| 911 | |
---|
| 912 | # An error during write to a shared object, unset |
---|
| 913 | set apa {a 1 b 2} |
---|
| 914 | set bepa $apa |
---|
| 915 | trace add variable bepa write {error hej} |
---|
| 916 | catch {dict unset bepa a} |
---|
| 917 | trace remove variable bepa write {error hej} |
---|
| 918 | unset bepa |
---|
| 919 | } |
---|
| 920 | } -constraints memory -body { |
---|
| 921 | set end [getbytes] |
---|
| 922 | for {set i 0} {$i < 5} {incr i} { |
---|
| 923 | stress |
---|
| 924 | set tmp $end |
---|
| 925 | set end [getbytes] |
---|
| 926 | } |
---|
| 927 | expr {$end - $tmp} |
---|
| 928 | } -cleanup { |
---|
| 929 | unset -nocomplain end i tmp |
---|
| 930 | rename getbytes {} |
---|
| 931 | rename stress {} |
---|
| 932 | } -result 0 |
---|
| 933 | |
---|
| 934 | test dict-20.1 {dict merge command} { |
---|
| 935 | dict merge |
---|
| 936 | } {} |
---|
| 937 | test dict-20.2 {dict merge command} { |
---|
| 938 | getOrder [dict merge {a b c d e f}] a c e |
---|
| 939 | } {a b c d e f 3} |
---|
| 940 | test dict-20.3 {dict merge command} -body { |
---|
| 941 | dict merge {a b c d e} |
---|
| 942 | } -result {missing value to go with key} -returnCodes 1 |
---|
| 943 | test dict-20.4 {dict merge command} { |
---|
| 944 | getOrder [dict merge {a b c d} {e f g h}] a c e g |
---|
| 945 | } {a b c d e f g h 4} |
---|
| 946 | test dict-20.5 {dict merge command} -body { |
---|
| 947 | dict merge {a b c d e} {e f g h} |
---|
| 948 | } -result {missing value to go with key} -returnCodes 1 |
---|
| 949 | test dict-20.6 {dict merge command} -body { |
---|
| 950 | dict merge {a b c d} {e f g h i} |
---|
| 951 | } -result {missing value to go with key} -returnCodes 1 |
---|
| 952 | test dict-20.7 {dict merge command} { |
---|
| 953 | getOrder [dict merge {a b c d e f} {e x g h}] a c e g |
---|
| 954 | } {a b c d e x g h 4} |
---|
| 955 | test dict-20.8 {dict merge command} { |
---|
| 956 | getOrder [dict merge {a b c d} {a x c y}] a c |
---|
| 957 | } {a x c y 2} |
---|
| 958 | test dict-20.9 {dict merge command} { |
---|
| 959 | getOrder [dict merge {a b c d} {a x c y}] a c |
---|
| 960 | } {a x c y 2} |
---|
| 961 | test dict-20.10 {dict merge command} { |
---|
| 962 | getOrder [dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}] a c e 1 3 |
---|
| 963 | } {a - c d e f 1 - 3 4 5} |
---|
| 964 | |
---|
| 965 | test dict-21.1 {dict update command} -body { |
---|
| 966 | dict update |
---|
| 967 | } -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} |
---|
| 968 | test dict-21.2 {dict update command} -body { |
---|
| 969 | dict update v |
---|
| 970 | } -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} |
---|
| 971 | test dict-21.3 {dict update command} -body { |
---|
| 972 | dict update v k |
---|
| 973 | } -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} |
---|
| 974 | test dict-21.4 {dict update command} -body { |
---|
| 975 | dict update v k v |
---|
| 976 | } -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"} |
---|
| 977 | test dict-21.5 {dict update command} { |
---|
| 978 | set a {b c} |
---|
| 979 | set result {} |
---|
| 980 | set bb {} |
---|
| 981 | dict update a b bb { |
---|
| 982 | lappend result $a $bb |
---|
| 983 | } |
---|
| 984 | lappend result $a |
---|
| 985 | } {{b c} c {b c}} |
---|
| 986 | test dict-21.6 {dict update command} { |
---|
| 987 | set a {b c} |
---|
| 988 | set result {} |
---|
| 989 | set bb {} |
---|
| 990 | dict update a b bb { |
---|
| 991 | lappend result $a $bb [set bb d] |
---|
| 992 | } |
---|
| 993 | lappend result $a |
---|
| 994 | } {{b c} c d {b d}} |
---|
| 995 | test dict-21.7 {dict update command} { |
---|
| 996 | set a {b c} |
---|
| 997 | set result {} |
---|
| 998 | set bb {} |
---|
| 999 | dict update a b bb { |
---|
| 1000 | lappend result $a $bb [unset bb] |
---|
| 1001 | } |
---|
| 1002 | lappend result $a |
---|
| 1003 | } {{b c} c {} {}} |
---|
| 1004 | test dict-21.8 {dict update command} { |
---|
| 1005 | set a {b c d e} |
---|
| 1006 | dict update a b v1 d v2 { |
---|
| 1007 | lassign "$v1 $v2" v2 v1 |
---|
| 1008 | } |
---|
| 1009 | getOrder $a b d |
---|
| 1010 | } {b e d c 2} |
---|
| 1011 | test dict-21.9 {dict update command} { |
---|
| 1012 | set a {b c d e} |
---|
| 1013 | dict update a b v1 d v2 {unset a} |
---|
| 1014 | info exist a |
---|
| 1015 | } 0 |
---|
| 1016 | test dict-21.10 {dict update command} { |
---|
| 1017 | set a {b {c d}} |
---|
| 1018 | dict update a b v1 { |
---|
| 1019 | dict update v1 c v2 { |
---|
| 1020 | set v2 foo |
---|
| 1021 | } |
---|
| 1022 | } |
---|
| 1023 | set a |
---|
| 1024 | } {b {c foo}} |
---|
| 1025 | test dict-21.11 {dict update command} { |
---|
| 1026 | set a {b c d e} |
---|
| 1027 | dict update a b v1 d v2 { |
---|
| 1028 | dict set a f g |
---|
| 1029 | } |
---|
| 1030 | getOrder $a b d f |
---|
| 1031 | } {b c d e f g 3} |
---|
| 1032 | test dict-21.12 {dict update command} { |
---|
| 1033 | set a {b c d e} |
---|
| 1034 | dict update a b v1 d v2 f v3 { |
---|
| 1035 | set v3 g |
---|
| 1036 | } |
---|
| 1037 | getOrder $a b d f |
---|
| 1038 | } {b c d e f g 3} |
---|
| 1039 | test dict-21.13 {dict update command: compilation} { |
---|
| 1040 | proc dicttest {d} { |
---|
| 1041 | while 1 { |
---|
| 1042 | dict update d a alpha b beta { |
---|
| 1043 | set beta $alpha |
---|
| 1044 | unset alpha |
---|
| 1045 | break |
---|
| 1046 | } |
---|
| 1047 | } |
---|
| 1048 | return $d |
---|
| 1049 | } |
---|
| 1050 | getOrder [dicttest {a 1 c 2}] b c |
---|
| 1051 | } {b 1 c 2 2} |
---|
| 1052 | test dict-21.14 {dict update command: compilation} { |
---|
| 1053 | proc dicttest x { |
---|
| 1054 | set indices {2 3} |
---|
| 1055 | trace add variable aa write "string length \$indices ;#" |
---|
| 1056 | dict update x k aa l bb {} |
---|
| 1057 | } |
---|
| 1058 | dicttest {k 1 l 2} |
---|
| 1059 | } {} |
---|
| 1060 | test dict-21.15 {dict update command: compilation} { |
---|
| 1061 | proc dicttest x { |
---|
| 1062 | set indices {2 3} |
---|
| 1063 | trace add variable aa read "string length \$indices ;#" |
---|
| 1064 | dict update x k aa l bb {} |
---|
| 1065 | } |
---|
| 1066 | dicttest {k 1 l 2} |
---|
| 1067 | } {} |
---|
| 1068 | test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} { |
---|
| 1069 | set foo {a {b {c {d {e 1}}}}} |
---|
| 1070 | dict update foo a t { |
---|
| 1071 | dict update t b t { |
---|
| 1072 | dict update t c t { |
---|
| 1073 | dict update t d t { |
---|
| 1074 | dict incr t e |
---|
| 1075 | } |
---|
| 1076 | } |
---|
| 1077 | } |
---|
| 1078 | } |
---|
| 1079 | string range [append foo OK] end-1 end |
---|
| 1080 | } OK |
---|
| 1081 | test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} { |
---|
| 1082 | proc dicttest {} { |
---|
| 1083 | set foo {a {b {c {d {e 1}}}}} |
---|
| 1084 | dict update foo a t { |
---|
| 1085 | dict update t b t { |
---|
| 1086 | dict update t c t { |
---|
| 1087 | dict update t d t { |
---|
| 1088 | dict incr t e |
---|
| 1089 | } |
---|
| 1090 | } |
---|
| 1091 | } |
---|
| 1092 | } |
---|
| 1093 | } |
---|
| 1094 | dicttest |
---|
| 1095 | string range [append foo OK] end-1 end |
---|
| 1096 | } OK |
---|
| 1097 | |
---|
| 1098 | test dict-22.1 {dict with command} -body { |
---|
| 1099 | dict with |
---|
| 1100 | } -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?key ...? script"} |
---|
| 1101 | test dict-22.2 {dict with command} -body { |
---|
| 1102 | dict with v |
---|
| 1103 | } -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?key ...? script"} |
---|
| 1104 | test dict-22.3 {dict with command} -body { |
---|
| 1105 | unset -nocomplain v |
---|
| 1106 | dict with v {error "in body"} |
---|
| 1107 | } -returnCodes 1 -result {can't read "v": no such variable} |
---|
| 1108 | test dict-22.4 {dict with command} { |
---|
| 1109 | set a {b c d e} |
---|
| 1110 | unset -nocomplain b d |
---|
| 1111 | set result [list [info exist b] [info exist d]] |
---|
| 1112 | dict with a { |
---|
| 1113 | lappend result [info exist b] [info exist d] $b $d |
---|
| 1114 | } |
---|
| 1115 | set result |
---|
| 1116 | } {0 0 1 1 c e} |
---|
| 1117 | test dict-22.5 {dict with command} { |
---|
| 1118 | set a {b c d e} |
---|
| 1119 | dict with a { |
---|
| 1120 | lassign "$b $d" d b |
---|
| 1121 | } |
---|
| 1122 | getOrder $a b d |
---|
| 1123 | } {b e d c 2} |
---|
| 1124 | test dict-22.6 {dict with command} { |
---|
| 1125 | set a {b c d e} |
---|
| 1126 | dict with a { |
---|
| 1127 | unset b |
---|
| 1128 | # This *won't* go into the dict... |
---|
| 1129 | set f g |
---|
| 1130 | } |
---|
| 1131 | set a |
---|
| 1132 | } {d e} |
---|
| 1133 | test dict-22.7 {dict with command} { |
---|
| 1134 | set a {b c d e} |
---|
| 1135 | dict with a { |
---|
| 1136 | dict unset a b |
---|
| 1137 | } |
---|
| 1138 | getOrder $a b d |
---|
| 1139 | } {b c d e 2} |
---|
| 1140 | test dict-22.8 {dict with command} { |
---|
| 1141 | set a [dict create b c] |
---|
| 1142 | dict with a { |
---|
| 1143 | set b $a |
---|
| 1144 | } |
---|
| 1145 | set a |
---|
| 1146 | } {b {b c}} |
---|
| 1147 | test dict-22.9 {dict with command} { |
---|
| 1148 | set a {b {c d}} |
---|
| 1149 | dict with a b { |
---|
| 1150 | set c $c$c |
---|
| 1151 | } |
---|
| 1152 | set a |
---|
| 1153 | } {b {c dd}} |
---|
| 1154 | test dict-22.10 {dict with command: result handling tricky case} { |
---|
| 1155 | set a {b {c d}} |
---|
| 1156 | foreach i {0 1} { |
---|
| 1157 | if {$i} break |
---|
| 1158 | dict with a b { |
---|
| 1159 | set a {} |
---|
| 1160 | # We're checking to see if we lose this break |
---|
| 1161 | break |
---|
| 1162 | } |
---|
| 1163 | } |
---|
| 1164 | list $i $a |
---|
| 1165 | } {0 {}} |
---|
| 1166 | test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} { |
---|
| 1167 | set foo {t {t {t {inner 1}}}} |
---|
| 1168 | dict with foo { |
---|
| 1169 | dict with t { |
---|
| 1170 | dict with t { |
---|
| 1171 | dict with t { |
---|
| 1172 | incr inner |
---|
| 1173 | } |
---|
| 1174 | } |
---|
| 1175 | } |
---|
| 1176 | } |
---|
| 1177 | string range [append foo OK] end-1 end |
---|
| 1178 | } OK |
---|
| 1179 | |
---|
| 1180 | # cleanup |
---|
| 1181 | ::tcltest::cleanupTests |
---|
| 1182 | return |
---|
| 1183 | |
---|
| 1184 | # Local Variables: |
---|
| 1185 | # mode: tcl |
---|
| 1186 | # End: |
---|