1#
2# keylist.test
3#
4# Tests for the keylget, keylkeys, keylset, and keyldel commands.
5#---------------------------------------------------------------------------
6# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans.
7#
8# Permission to use, copy, modify, and distribute this software and its
9# documentation for any purpose and without fee is hereby granted, provided
10# that the above copyright notice appear in all copies.  Karl Lehenbauer and
11# Mark Diekhans make no representations about the suitability of this
12# software for any purpose.  It is provided "as is" without express or
13# implied warranty.
14#------------------------------------------------------------------------------
15# $Id: keylist.test,v 1.4 2005/11/18 00:01:50 hobbs Exp $
16#------------------------------------------------------------------------------
17#
18
19if {[cequal [info procs Test] {}]} {
20    source [file join [file dirname [info script]] testlib.tcl]
21}
22
23#
24# Some pre-build keyed lists to test with.
25#
26
27set list1 {{keyA valueA} {keyB valueB} {keyD valueD}}
28set list2 {{keyA valueA} {keyB {{keyB1 valueB1} {keyB2 valueB2}}}
29           {keyD valueD}}
30set list3 {{C {{CC {{CCC ccc}}}}} {A {{AA aa} {AB ab}}}
31           {B {{BA ba} {BB bb} {BC {{BBB bbb}}}}}}
32set list4 [list [list keyA "value\0A"] [list keyB value\0\1\0B] \
33        [list keyD \0value\0D]]
34
35Test keylist-1.1 {keylget tests} {
36    keylget list1 keyA
37} 0 {valueA}
38
39Test keylist-1.2 {keylget tests} {
40    list [keylget list1 keyA value] $value
41} 0 {1 valueA}
42
43Test keylist-1.3 {keylget tests} {
44    keylget list2 keyD
45} 0 {valueD}
46
47Test keylist-1.4 {keylget tests} {
48    list [keylget list2 keyD value] $value
49} 0 {1 valueD}
50
51Test keylist-1.6 {keylget tests} {
52    keylget list2 keyC value
53} 0 {0}
54
55Test keylist-1.7 {keylget tests} {
56    keylget list2 keyB
57} 0 {{keyB1 valueB1} {keyB2 valueB2}}
58
59Test keylist-1.8 {keylget tests} {
60    keylget list2
61} 0 {keyA keyB keyD}
62
63Test keylist-1.9 {keylget tests} {
64    set keyedlist {}
65    keylget keyedlist keyC value
66} 0 {0}
67
68Test keylist-1.10 {keylget tests} {
69    set keyedlist {}
70    keylget keyedlist
71} 0 {}
72
73Test keylist-1.11 {keylget tests} {
74    set keyedlist $list2
75    keylget keyedlist keyB.keyB1
76} 0 {valueB1}
77
78Test keylist-1.12 {keylget tests} {
79    set keyedlist $list2
80    keylget keyedlist keyB.keyB2
81} 0 {valueB2}
82
83Test keylist-1.13 {keylget tests} {
84    set keyedlist $list3
85    keylget keyedlist C
86} 0 {{CC {{CCC ccc}}}}
87
88Test keylist-1.14 {keylget tests} {
89    set keyedlist $list3
90    keylget keyedlist C.CC
91} 0 {{CCC ccc}}
92
93Test keylist-1.15 {keylget tests} {
94    set keyedlist $list3
95    keylget keyedlist C.CC.CCC
96} 0 {ccc}
97
98Test keylist-1.16 {keylget tests} {
99    set keyedlist $list3
100    keylget keyedlist A.AB
101} 0 {ab}
102
103Test keylist-1.17 {keylget tests} {
104    set keyedlist $list3
105    keylget keyedlist B.BC
106} 0 {{BBB bbb}}
107
108Test keylist-1.18 {keylget tests} {
109    keylget list2 keyC
110} 1 {key "keyC" not found in keyed list}
111
112Test keylist-1.19 {keylget tests} {
113    set keyedlist {{} {keyB valueB} {keyD valueD}}
114    keylget keyedlist keyB
115} 1 {keyed list entry must be a valid, 2 element list, got ""}
116
117Test keylist-1.20 {keylget tests} {
118    set keyedlist {keyA {keyB valueB} {keyD valueD}}
119    keylget keyedlist keyB
120} 1 {keyed list entry must be a valid, 2 element list, got "keyA"}
121
122Test keylist-1.21 {keylget tests} {
123    set keyedlist {{{} valueA} {keyB valueB} {keyD valueD}}
124    keylget keyedlist keyB
125} 1 {keyed list key may not be an empty string}
126
127Test keylist-1.21 {keylget tests} {
128    set keyedlist {{{} valueA} {keyB valueB} {keyD valueD}}
129    keylget keyedlist keyB
130} 1 {keyed list key may not be an empty string}
131
132Test keylist-1.24 {keylget tests} {
133    set keyedlist {{{key.A} valueA} {keyB valueB} {keyD valueD}}
134    keylget keyedlist keyB
135} 1 {keyed list key may not contain a "."; it is used as a separator in key paths}
136
137Test keylist-1.25 {keylget tests} {
138    keylget
139} 1 {wrong # args: keylget listvar ?key? ?retvar | {}?}
140
141Test keylist-1.26 {keylget tests} {
142    unset keyedlist
143    keylset keyedlist keyA aaa"bbb
144    keylget keyedlist keyA
145} 0 {aaa"bbb}
146
147Test keylist-1.27 {keylget tests} {
148    keylget list4 keyA
149} 0 "value\0A"
150
151Test keylist-1.28 {keylget tests} {
152    keylget list4 keyB
153} 0 "value\0\1\0B"
154
155Test keylist-1.29 {keylget tests} {
156    keylget list4 keyD
157} 0 "\0value\0D"
158
159
160
161Test keylist-2.1 {keylkeys tests} {
162    keylkeys list1
163} 0 {keyA keyB keyD}
164
165Test keylist-2.2 {keylkeys tests} {
166    keylkeys list2
167} 0 {keyA keyB keyD}
168
169Test keylist-2.3 {keylkeys tests} {
170    keylkeys list2 keyB
171} 0 {keyB1 keyB2}
172
173Test keylist-2.4 {keylkeys tests} {
174    set keyedlist $list3
175    keylkeys keyedlist
176} 0 {C A B}
177
178Test keylist-2.5 {keylkeys tests} {
179    set keyedlist $list3
180    keylkeys keyedlist C
181} 0 {CC}
182
183Test keylist-2.6 {keylkeys tests} {
184    set keyedlist $list3
185    keylkeys keyedlist C.CC
186} 0 {CCC}
187
188Test keylist-2.7 {keylkeys tests} {
189    set keyedlist $list3
190    keylkeys keyedlist B.BC
191} 0 {BBB}
192
193Test keylist-2.8 {keylkeys tests} {
194    keylkeys
195} 1 {wrong # args: keylkeys listvar ?key?}
196
197Test keylist-2.9 {keylkeys tests} {
198    keylkeys list4
199} 0 {keyA keyB keyD}
200
201Test keylist-3.1 {keylset tests} {
202    catch {unset keyedlist}
203    keylset keyedlist keyA valueA
204    set keyedlist
205} 0 {{keyA valueA}}
206
207Test keylist-3.2 {keylset tests} {
208    catch {unset keyedlist}
209    keylset keyedlist keyA valueA
210    keylset keyedlist keyB valueB
211    set keyedlist
212} 0 {{keyA valueA} {keyB valueB}}
213
214Test keylist-3.3 {keylset tests} {
215    catch {unset keyedlist}
216    keylset keyedlist keyA valueA
217    keylset keyedlist keyB valueB keyB valueB2
218    set keyedlist
219} 0 {{keyA valueA} {keyB valueB2}}
220
221Test keylist-3.3.1 {keylset tests} {
222    catch {unset keyedlist}
223    keylset keyedlist keyA value\0A
224    keylset keyedlist keyB \0valueB keyB \0value\0\1\0B2
225    set keyedlist
226} 0 [list [list keyA value\0A] [list keyB \0value\0\1\0B2]]
227
228Test keylist-3.4 {keylset tests} {
229    catch {unset keyedlist}
230    keylset keyedlist keyA valueA
231    keylset keyedlist keyB valueB
232    keylset keyedlist keyA valueA2 keyB valueB2 keyC valueC
233    set keyedlist
234} 0 {{keyA valueA2} {keyB valueB2} {keyC valueC}}
235
236Test keylist-3.5 {keylset tests} {
237    catch {unset keyedlist}
238    keylset keyedlist keyA
239} 1 {wrong # args: keylset listvar key value ?key value...?}
240
241Test keylist-3.6 {keylset tests} {
242    catch {unset keyedlist}
243    keylset keyedlist keyA valueA keyB
244} 1 {wrong # args: keylset listvar key value ?key value...?}
245
246Test keylist-3.7 {keylset tests} {
247    catch {unset keyedlist}
248    set keyedlist(foo) 1
249    keylset keyedlist keyA valueA
250} 1 {can't set "keyedlist": variable is array}
251
252Test keylist-3.8 {keylset tests} {
253    catch {unset keyedlist}
254    set keyedlist {{keyA valueA valueBad} {keyB valueB}}
255    keylset keyedlist keyA valueA
256} 1 {keyed list entry must be a valid, 2 element list, got "keyA valueA valueBad"}
257
258Test keylist-3.8.1 {keylset tests} {
259    catch {unset keyedlist}
260    keylset keyedlist {} valueA
261} 1 {keyed list key may not be an empty string}
262
263Test keylist-3.9 {keylset tests} {
264    set keyedlist {}
265    keylset keyedlist C.CC.CCC ccc
266    set keyedlist
267} 0 {{C {{CC {{CCC ccc}}}}}}
268
269Test keylist-3.10 {keylset tests} {
270    keylset keyedlist A.AA aa
271    set keyedlist
272} 0 {{C {{CC {{CCC ccc}}}}} {A {{AA aa}}}}
273
274Test keylist-3.11 {keylset tests} {
275    keylset keyedlist A.AB ab
276    set keyedlist
277} 0 {{C {{CC {{CCC ccc}}}}} {A {{AA aa} {AB ab}}}}
278
279Test keylist-3.12 {keylset tests} {
280    keylset keyedlist B.BA ba
281    set keyedlist
282} 0 {{C {{CC {{CCC ccc}}}}} {A {{AA aa} {AB ab}}} {B {{BA ba}}}}
283
284Test keylist-3.13 {keylset tests} {
285    keylset keyedlist B.BB bb
286    set keyedlist
287} 0 {{C {{CC {{CCC ccc}}}}} {A {{AA aa} {AB ab}}} {B {{BA ba} {BB bb}}}}
288
289Test keylist-3.14 {keylset tests} {
290    keylset keyedlist B.BC.BBB bbb
291    set keyedlist
292} 0 {{C {{CC {{CCC ccc}}}}} {A {{AA aa} {AB ab}}} {B {{BA ba} {BB bb} {BC {{BBB bbb}}}}}}
293
294Test keylist-3.15 {keylset tests} {
295    set keyedlist {}
296    keylset keyedlist ABCDEF value1
297    keylset keyedlist A.SUB  value2
298    list $keyedlist [keylkeys keyedlist]
299} 0 {{{ABCDEF value1} {A {{SUB value2}}}} {ABCDEF A}}
300
301Test keylist-3.16 {keylset tests} {
302    set keyedlist {}
303    keylset keyedlist A.SUB  value1
304    keylset keyedlist ABCDEF value2
305    list $keyedlist [keylkeys keyedlist]
306} 0 {{{A {{SUB value1}}} {ABCDEF value2}} {A ABCDEF}}
307
308Test keylist-4.1 {keyldel tests} {
309    set keyedlist {{keyA valueA} {keyB valueB} {keyD valueD}}
310    keyldel keyedlist keyB
311    set keyedlist
312} 0 {{keyA valueA} {keyD valueD}}
313
314Test keylist-4.2 {keyldel tests} {
315    set keyedlist {{keyA valueA} {keyB valueB} {keyD valueD}}
316    keyldel keyedlist keyB
317    keyldel keyedlist keyA
318    set keyedlist
319} 0 {{keyD valueD}}
320
321Test keylist-4.3 {keyldel tests} {
322    set keyedlist {{keyA valueA} {keyB valueB} {keyD valueD}}
323    keyldel keyedlist keyD
324    keyldel keyedlist keyB
325    keyldel keyedlist keyA
326    set keyedlist
327} 0 {}
328
329Test keylist-4.4 {keyldel tests} {
330    set keyedlist {{keyA valueA} {keyB valueB} {keyD valueD}}
331    keyldel keyedlist keyC
332} 1 {key not found: "keyC"}
333
334Test keylist-4.5 {keyldel tests} {
335    keyldel keyedlist
336} 1 {wrong # args: keyldel listvar key ?key ...?}
337
338Test keylist-4.6 {keyldel tests} {
339    set keyedlist $list3
340    keyldel keyedlist B.BA
341    set keyedlist
342} 0 {{C {{CC {{CCC ccc}}}}} {A {{AA aa} {AB ab}}} {B {{BB bb} {BC {{BBB bbb}}}}}}
343
344Test keylist-4.7 {keyldel tests} {
345    keyldel keyedlist A.AA
346    set keyedlist
347} 0 {{C {{CC {{CCC ccc}}}}} {A {{AB ab}}} {B {{BB bb} {BC {{BBB bbb}}}}}}
348
349Test keylist-4.8 {keyldel tests} {
350    keyldel keyedlist C.CC.CCC
351    set keyedlist
352} 0 {{A {{AB ab}}} {B {{BB bb} {BC {{BBB bbb}}}}}}
353
354Test keylist-4.9 {keyldel tests} {
355    keyldel keyedlist A.AB
356    set keyedlist
357} 0 {{B {{BB bb} {BC {{BBB bbb}}}}}}
358
359Test keylist-4.10 {keyldel tests} {
360    keyldel keyedlist B.BC.BBB
361    set keyedlist
362} 0 {{B {{BB bb}}}}
363
364Test keylist-4.11 {keyldel tests} {
365    keyldel keyedlist B.BB
366    set keyedlist
367} 0 {}
368
369Test keylist-4.12 {keyldel tests} {
370    set keyedlist $list3
371    keyldel keyedlist B
372    set keyedlist
373} 0 {{C {{CC {{CCC ccc}}}}} {A {{AA aa} {AB ab}}}}
374
375Test keylist-4.13 {keyldel tests} {
376    keyldel keyedlist A
377    set keyedlist
378} 0 {{C {{CC {{CCC ccc}}}}}}
379
380Test keylist-4.14 {keyldel tests} {
381    keyldel keyedlist C
382    set keyedlist
383} 0 {}
384
385Test keylist-4.15 {keyldel tests} {
386    set keyedlist $list3
387    keyldel keyedlist B A
388    set keyedlist
389} 0 {{C {{CC {{CCC ccc}}}}}}
390
391# Handling of empty lists.
392
393set keyedlist {}
394
395Test keylist-5.1 {empty keyed list tests} {
396    keylget keyedlist
397} 0 {}
398
399Test keylist-5.2 {empty keyed list tests} {
400    keylkeys keyedlist
401} 0 {}
402
403Test keylist-5.3 {empty keyed list tests} {
404    keylget keyedlist A
405} 1 {key "A" not found in keyed list}
406
407set keyedlist { 	 }
408
409Test keylist-5.4 {empty keyed list tests} {
410    keylget keyedlist
411} 0 {}
412
413Test keylist-5.5 {empty keyed list tests} {
414    keylkeys keyedlist
415} 0 {}
416
417Test keylist-5.6 {empty keyed list tests} {
418    keylget keyedlist A
419} 1 {key "A" not found in keyed list}
420
421
422#
423# Some stress cases. Cause table expansions, etc.
424#
425
426#
427# Proc to recurse through generated keyed list name space and execute
428# commands.  Variables `keyedList', `key' and `depth' maybe use in the
429# commands.
430#
431proc PoundKeyedList {klVar depth field entrySizes leafCmd branchCmd} {
432    upvar $klVar keyedList
433
434    if [lempty $field] {
435        set separ ""
436    } else {
437        set separ .
438    }
439    set keybase [ctype char [expr [ctype ord A]+$depth]]
440    for {set keyIdx 0} {$keyIdx < [lindex $entrySizes 0]} {incr keyIdx} {
441        set key "${field}${separ}${keybase}_${keyIdx}"
442        if {[llength $entrySizes] > 1} {
443            eval $branchCmd
444            PoundKeyedList keyedList [expr $depth + 1] $key \
445                    [lrange $entrySizes 1 end] $leafCmd $branchCmd
446        } else {
447            eval $leafCmd
448        }
449    }
450}
451
452#
453# Build, access and delete elements from a keyed list which is wide at the top.
454#
455Test keylist-6.0 {large list tests} {
456    set keyedList {}
457    PoundKeyedList keyedList 0 "" {50 2 3} {
458        keylset keyedList $key VAL_$key
459    } {}
460    PoundKeyedList keyedList 0 "" {50 2 3} {
461        if ![cequal [keylget keyedList $key] VAL_$key] {
462            error "got value of \"[keylget keyedList $key]\", \
463                    expected \"VAL_$key\""
464        }
465    } {}
466    PoundKeyedList keyedList 0 "" {50 2 3} {
467        keyldel keyedList $key
468    } {}
469    set keyedList
470} 0 {}
471
472#
473# Build, access and delete elements from a keyed list which is wide at the top.
474# Do it with odd keys then even keys, reverse order of access, then again for
475# delete.
476#
477Test keylist-6.1 {large list tests} {
478    set keyedList {}
479    PoundKeyedList keyedList 0 "" {50 2 3} {
480        if {($keyIdx % 2) == 0} {
481            keylset keyedList $key VAL_$key
482        }
483    } {}
484    PoundKeyedList keyedList 0 "" {50 2 3} {
485        if {($keyIdx % 2) == 1} {
486            keylset keyedList $key VAL_$key
487        }
488    } {}
489    PoundKeyedList keyedList 0 "" {50 2 3} {
490        if {($keyIdx % 2) == 1} {
491            if ![cequal [keylget keyedList $key] VAL_$key] {
492                error "got value of \"[keylget keyedList $key]\", \
493                        expected \"VAL_$key\""
494            }
495        }
496    } {}
497    PoundKeyedList keyedList 0 "" {50 2 3} {
498        if {($keyIdx % 2) == 0} {
499            if ![cequal [keylget keyedList $key] VAL_$key] {
500                error "got value of \"[keylget keyedList $key]\", \
501                        expected \"VAL_$key\""
502            }
503        }
504    } {}
505    PoundKeyedList keyedList 0 "" {50 2 3} {
506        if {($keyIdx % 2) == 0} {
507            keyldel keyedList $key
508        }
509    } {}
510    PoundKeyedList keyedList 0 "" {50 2 3} {
511        if {($keyIdx % 2) == 1} {
512            keyldel keyedList $key
513        }
514    } {}
515    set keyedList
516} 0 {}
517
518#
519# Build, access and delete elements from a keyed list which is wide in the
520# middle.
521#
522Test keylist-6.2 {large list tests} {
523    set keyedList {}
524    PoundKeyedList keyedList 0 "" {10 30 5} {
525        keylset keyedList $key VAL_$key
526    } {}
527    PoundKeyedList keyedList 0 "" {10 30 5} {
528        if ![cequal [keylget keyedList $key] VAL_$key] {
529            error "got value of \"[keylget keyedList $key]\", \
530                    expected \"VAL_$key\""
531        }
532    } {}
533    PoundKeyedList keyedList 0 "" {10 30 5} {
534        keyldel keyedList $key
535    } {}
536    set keyedList
537} 0 {}
538
539#
540# Build, access and delete elements from a keyed list which is deep.
541#
542Test keylist-6.3 {large list tests} {
543    set keyedList {}
544    PoundKeyedList keyedList 0 "" {3 3 3 3 3 3} {
545        keylset keyedList $key VAL_$key
546    } {}
547    PoundKeyedList keyedList 0 "" {3 3 3 3 3 3} {
548        if ![cequal [keylget keyedList $key] VAL_$key] {
549            error "got value of \"[keylget keyedList $key]\", \
550                    expected \"VAL_$key\""
551        }
552    } {}
553    PoundKeyedList keyedList 0 "" {3 3 3 3 3 3} {
554        keyldel keyedList $key
555    } {}
556    set keyedList
557} 0 {}
558
559#
560# Shared obj subkeys - watch for entries/hash consistency
561#
562Test keylist-7.1 {shared obj key} {
563    set zz {}
564
565    keylset zz aa.foo 1
566    # this will cause the subkey to have a shared obj, causing call to
567    # DupSharedKeyListChild on next set
568    keylget zz aa -
569    keylset zz aa.bar 1
570    keyldel zz aa.foo
571    keyldel zz aa.bar
572    set zz
573} 0 {}
574
575# cleanup
576::tcltest::cleanupTests
577return
578