1# -*- tcl -*-
2# huddle.test:  tests for the huddle library.
3#
4# Copyright (c) 2008 by KATO Kanryu <kanryu6@users.sourceforge.net>
5# All rights reserved.
6#
7
8if {[lsearch [namespace children] ::tcltest] == -1} {
9    # single test
10    set selfrun 1
11    lappend auto_path [pwd]
12    package require tcltest
13    namespace import ::tcltest::*
14
15    source huddle.tcl
16    package require json
17
18    proc dictsort {dict} {
19        array set a $dict
20        set out [list]
21        foreach key [lsort [array names a]] {
22            lappend out $key $a($key)
23        }
24        return $out
25    }
26} else {
27    # all.tcl
28    source [file join \
29        [file dirname [file dirname [file join [pwd] [info script]]]] \
30        devtools testutilities.tcl]
31
32    testsNeedTcl     8.5
33    testsNeedTcltest 2
34    #testsNeed dict 1
35
36    support {
37    use json/json.tcl json
38    }
39    testing {
40        useLocal huddle.tcl huddle
41    }
42}
43
44test huddle-1.1 "test of huddle create" -body {
45    set upper [huddle create a b c d]
46} -result {HUDDLE {D {a {s b} c {s d}}}}
47
48test huddle-1.2 "test of huddle create" -body {
49    set upper2 [huddle create e f g h]
50    set upper3 [huddle create i j k l]
51    set folding [huddle create bb $upper cc $upper2]
52} -result {HUDDLE {D {bb {D {a {s b} c {s d}}} cc {D {e {s f} g {s h}}}}}}
53
54test huddle-1.3 "test of huddle create" -body {
55    set folding [huddle create dd $folding ee $upper3]
56    set data_dict $folding
57} -result {HUDDLE {D {dd {D {bb {D {a {s b} c {s d}}} cc {D {e {s f} g {s h}}}}} ee {D {i {s j} k {s l}}}}}}
58
59test huddle-1.4 "test of huddle create" -body {
60    huddle get $folding dd
61} -result {HUDDLE {D {bb {D {a {s b} c {s d}}} cc {D {e {s f} g {s h}}}}}}
62
63test huddle-1.5 "test of huddle create" -body {
64    huddle get $folding dd cc
65} -result {HUDDLE {D {e {s f} g {s h}}}}
66
67test huddle-1.6 "test of huddle create" -body {
68    huddle get_stripped $folding dd
69} -result {bb {a b c d} cc {e f g h}}
70
71test huddle-1.7 "test of huddle create" -body {
72    huddle get_stripped $folding dd cc
73} -result {e f g h}
74
75test huddle-1.8 "test of huddle create" -body {
76    huddle type $folding dd
77} -result {dict}
78
79test huddle-1.9 "test of huddle create" -body {
80    huddle type $folding dd cc
81} -result {dict}
82
83test huddle-1.10 "test of huddle create" -body {
84    huddle type $folding dd cc g
85} -result {string}
86
87test huddle-2.1 "test of huddle list" -body {
88    set upper [huddle list a b c d]
89} -result {HUDDLE {L {{s a} {s b} {s c} {s d}}}}
90
91test huddle-2.2 "test of huddle list" -body {
92    set upper2 [huddle list e f g h]
93    set folding [huddle list i $upper j k $upper2]
94} -result {HUDDLE {L {{s i} {L {{s a} {s b} {s c} {s d}}} {s j} {s k} {L {{s e} {s f} {s g} {s h}}}}}}
95
96test huddle-2.3 "test of huddle list" -body {
97    set folding [huddle list $folding t u]
98    set data_list $folding
99} -result {HUDDLE {L {{L {{s i} {L {{s a} {s b} {s c} {s d}}} {s j} {s k} {L {{s e} {s f} {s g} {s h}}}}} {s t} {s u}}}}
100
101test huddle-2.4 "test of huddle list" -body {
102    huddle get $folding 0
103} -result {HUDDLE {L {{s i} {L {{s a} {s b} {s c} {s d}}} {s j} {s k} {L {{s e} {s f} {s g} {s h}}}}}}
104
105test huddle-2.5 "test of huddle list" -body {
106    huddle get $folding 0 1
107} -result {HUDDLE {L {{s a} {s b} {s c} {s d}}}}
108
109test huddle-2.6 "test of huddle list" -body {
110    huddle get_stripped $folding 0
111} -result {i {a b c d} j k {e f g h}}
112
113test huddle-2.7 "test of huddle list" -body {
114    huddle get_stripped $folding 0 1
115} -result {a b c d}
116
117test huddle-2.8 "test of huddle list" -body {
118    huddle type $folding 0
119} -result {list}
120
121test huddle-2.9 "test of huddle list" -body {
122    huddle type $folding 0 1
123} -result {list}
124
125test huddle-2.10 "test of huddle list" -body {
126    huddle type $folding 0 1 3
127} -result {string}
128
129test huddle-2.11 "test of huddle list" -body {
130    huddle get_stripped {HUDDLE {L {{s a} {L {}} {s c}}}}
131} -result {a {} c}
132
133#test huddle-3.1 "test of huddle jsondump" {[info tclversion] >= 8.5} {
134#    # build a huddle container from normal tcl's container(multi rank dict/list)
135#    proc huddle_build {data} {
136#        foreach {key val} $data {
137#            if {$key eq "layers"} {
138#                foreach {l} [dict get $data layers] {
139#                    lappend subs [huddle_build $l]
140#                }
141#                set val [eval huddle list $subs]
142#            }
143#            lappend result $key $val
144#        }
145#        return [eval huddle create $result]
146#    }
147#    set fd [open [asset layers.txt] r]
148#    set json1 [read $fd]
149#    close $fd
150#
151#    set data [json::json2dict $json1]
152##    set data [huddle_build $data]
153##
154##    set json2 [huddle jsondump $data]
155##    expr $json1 eq $json2
156##    set json2
157#} {1}
158
159test huddle-3.2 "test of huddle jsondump" -body {
160    huddle jsondump {HUDDLE {L {{L {{s i} {s baa} {s k} {L {{num 1.0} {b true} {s g} {s h}}}}} {s t}}}}
161} -result {[
162  [
163    "i",
164    "baa",
165    "k",
166    [
167      1.0,
168      true,
169      "g",
170      "h"
171    ]
172  ],
173  "t"
174]}
175
176
177test huddle-3.3 "test of huddle jsondump" -body {
178    set huddle1 {HUDDLE {D {dd {D {bb {D {a {s baa} c {s {d a}}}} cc {D {g {s h}}}}} ee {D {i {s j} k {num 1} j {s { m\a}}}}}}}
179    set json1 [huddle jsondump $huddle1]
180    set json2 {{
181  "dd": {
182    "bb": {
183      "a": "baa",
184      "c": "d a"
185    },
186    "cc": {"g": "h"}
187  },
188  "ee": {
189    "i": "j",
190    "k": 1,
191    "j": " m\\a"
192  }
193}}
194
195    if {$json1 == $json2} {
196    return 1
197    } else {
198    return 0
199    }
200} -result {1}
201
202
203test huddle-3.4 "test of huddle compile" -body {
204    set huddle1 {HUDDLE {D {dd {D {bb {D {a {s baa} c {s {d a}}}} cc {D {g {s h}}}}} ee {D {i {s j} k {num 1} j {s { m\a}}}}}}}
205    set json1 {{
206  "dd": {
207    "bb": {
208      "a": "baa",
209      "c": "d a"
210    },
211    "cc": {"g": "h"}
212  },
213  "ee": {
214    "i": "j",
215    "k": 1,
216    "j": " m\\a"
217  }
218}}
219
220    set data [json::json2dict $json1]
221    set data [huddle compile {dict dd {dict * dict} ee {dict k number * string}}  $data]
222    huddle equal $huddle1 $data
223} -result {1}
224
225test huddle-3.5 "test of huddle jsondump - null handling" -body {
226    huddle jsondump {HUDDLE null}
227} -result {null}
228
229test huddle-3.6 "test of huddle jsondump - dict and null handling" -body {
230    huddle jsondump {HUDDLE {D {a {s foo} b null}}}
231} -result {{
232  "a": "foo",
233  "b": null
234}}
235
236# ... Tests of addStrings ...
237#     (Requires introspection of parser state)
238
239test huddle-4.1 "test of huddle set" -body {
240    huddle set data_dict dd bb a baa
241} -result {HUDDLE {D {dd {D {bb {D {a {s baa} c {s d}}} cc {D {e {s f} g {s h}}}}} ee {D {i {s j} k {s l}}}}}}
242
243test huddle-4.2 "test of huddle remove" -body {
244    set data_dict [huddle remove $data_dict dd cc e]
245} -result {HUDDLE {D {dd {D {bb {D {a {s baa} c {s d}}} cc {D {g {s h}}}}} ee {D {i {s j} k {s l}}}}}}
246
247test huddle-4.3 "test of huddle set" -body {
248    huddle set data_list 0 1 baa
249} -result {HUDDLE {L {{L {{s i} {s baa} {s j} {s k} {L {{s e} {s f} {s g} {s h}}}}} {s t} {s u}}}}
250
251test huddle-4.4 "test of huddle remove" -body {
252    set data_list [huddle remove $data_list 0 2]
253} -result {HUDDLE {L {{L {{s i} {s baa} {s k} {L {{s e} {s f} {s g} {s h}}}}} {s t} {s u}}}}
254
255test huddle-4.5 "test of huddle equal" -body {
256    huddle equal $data_dict {HUDDLE {D {dd {D {bb {D {a {s baa} c {s d}}} cc {D {g {s h}}}}} ee {D {i {s j} k {s l}}}}}}
257} -result 1
258
259test huddle-4.6 "test of huddle equal" -body {
260    huddle equal $data_dict {HUDDLE {D {dd {D {bb {D {a {s lll} c {s d}}} cc {D {g {s h}}}}} ee {D {i {s j} k {s l}}}}}}
261} -result 0
262
263test huddle-4.7 "test of huddle equal" -body {
264    huddle equal $data_dict {HUDDLE {D {dd {D {bb {D {a {s baa} c {s d}}} cc {D {g {s h}}}}} ee {D {i {s j} k {s l} j {s m}}}}}}
265} -result 0
266
267test huddle-4.8 "test of huddle equal" -body {
268    huddle equal $data_list {HUDDLE {L {{L {{s i} {s baa} {s k} {L {{s e} {s f} {s g} {s h}}}}} {s t} {s u}}}}
269} -result 1
270
271test huddle-4.9 "test of huddle equal" -body {
272    huddle equal $data_list {HUDDLE {L {{L {{s i} {s kkk} {s k} {L {{s e} {s f} {s g} {s h}}}}} {s t} {s u}}}}
273} -result 0
274
275test huddle-4.10 "test of huddle equal" -body {
276    huddle equal $data_list {HUDDLE {L {{L {{s i} {s baa} {s k} {L {{s e} {s f} {s g} {s h}}}}} {s t}}}}
277} -result 0
278
279test huddle-5.1 "test of huddle boolean" -body {
280    huddle true
281} -result {HUDDLE {b true}}
282
283test huddle-5.2 "test of huddle boolean" -body {
284    huddle false
285} -result {HUDDLE {b false}}
286
287test huddle-6.1 "test of huddle null" -body {
288    huddle null
289} -result {HUDDLE null}
290
291test huddle-7.1 "test of huddle number" -body {
292    huddle number -4.5E-6
293} -result {HUDDLE {num -4.5E-6}}
294
295
296test huddle-8.1 "test of complex data structure using the new types: number, boolean and null" -body {
297    huddle create key1 var1 key2 [huddle number 4] key3 [huddle list [huddle null] sadf [huddle true]]
298} -result {HUDDLE {D {key1 {s var1} key2 {num 4} key3 {L {null {s sadf} {b true}}}}}}
299
300
301test huddle-9.1 "test of huddle exists" -body {
302    set obj [huddle list [huddle create key1 2 key3 4] 1 2 [huddle list  1 2 [huddle list 1 2]] ]
303    huddle exists $obj 0 key1
304} -result {1}
305
306test huddle-9.2 "test of huddle exists" -body {
307    set obj [huddle list [huddle create key1 2 key3 4] 1 2 [huddle list  1 2 [huddle list 1 2]] ]
308    huddle exists $obj 3 2 1
309} -result {1}
310
311test huddle-9.1 "test of huddle exists" -body {
312    set obj [huddle list [huddle create key1 2 key3 4] 1 2 [huddle list  1 2 [huddle list 1 2]] ]
313    huddle exists $obj 0 key1
314} -result {1}
315
316test huddle-9.3 "test of huddle exists" -body {
317    set obj [huddle list [huddle create key1 2 key3 4] 1 2 [huddle list  1 2 [huddle list 1 2]] ]
318    huddle exists $obj 3 3 1
319} -result {0}
320
321test huddle-10.1 "test of huddle clone" -body {
322    set obj [huddle list item0 item1 [huddle create key0 value0 key1 value1]]
323    huddle clone $obj
324} -result {HUDDLE {L {{s item0} {s item1} {D {key0 {s value0} key1 {s value1}}}}}}
325
326
327test huddle-11.1 "test of huddle superclass" -body {
328
329    namespace eval ::new_types::mapping {
330
331        variable settings
332        set settings {
333                superclass dict
334                publicMethods {mapping}
335                tag !!map
336                isContainer yes }
337
338        proc mapping {args} {
339            if {[llength $args] % 2} {error {wrong # args: should be "huddle mapping ?key value ...?"}}
340            set resultL {}
341            foreach {key value} $args {
342                lappend resultL $key [argument_to_node $value !!str]
343            }
344
345            return [wrap [list !!map $resultL]]
346        }
347
348    }
349
350    namespace eval ::new_types::str {
351
352            variable settings
353            set settings {
354                    superclass string
355                    publicMethods {}
356                    isContainer no
357                    tag !!str
358            }
359    }
360
361    huddle addType ::new_types::mapping
362    huddle addType ::new_types::str
363
364    set a [huddle mapping key1 var1]
365    huddle append a key2 [huddle mapping key3 var3]
366} -result {HUDDLE {!!map {key1 {!!str var1} key2 {!!map {key3 {!!str var3}}}}}}
367
368
369
370if {[info exists selfrun]} {
371    tcltest::cleanupTests
372} else {
373    testsuiteCleanup
374}
375