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