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: |
---|