# -*- tcl -*- # huddle.test: tests for the huddle library. # # Copyright (c) 2008 by KATO Kanryu # All rights reserved. # # -------------------------------------------------------------------- if {[lsearch [namespace children] ::tcltest] == -1} { # single test set selfrun 1 lappend auto_path [pwd] package require tcltest namespace import ::tcltest::* source huddle.tcl package require json proc dictsort {dict} { array set a $dict set out [list] foreach key [lsort [array names a]] { lappend out $key $a($key) } return $out } } else { # all.tcl source [file join \ [file dirname [file dirname [file join [pwd] [info script]]]] \ devtools testutilities.tcl] testsNeedTcl 8.5 testsNeedTcltest 2 #testsNeed dict 1 support { use json/json.tcl json } testing { useLocal huddle.tcl huddle } } # -------------------------------------------------------------------- test huddle-1.1 "test of huddle create" -body { set upper [huddle create a b c d] } -result {HUDDLE {D {a {s b} c {s d}}}} test huddle-1.2 "test of huddle create" -body { set upper2 [huddle create e f g h] set upper3 [huddle create i j k l] set folding [huddle create bb $upper cc $upper2] } -result {HUDDLE {D {bb {D {a {s b} c {s d}}} cc {D {e {s f} g {s h}}}}}} test huddle-1.3 "test of huddle create" -body { set folding [huddle create dd $folding ee $upper3] set data_dict $folding } -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}}}}}} test huddle-1.4 "test of huddle create" -body { huddle get $folding dd } -result {HUDDLE {D {bb {D {a {s b} c {s d}}} cc {D {e {s f} g {s h}}}}}} test huddle-1.5 "test of huddle create" -body { huddle get $folding dd cc } -result {HUDDLE {D {e {s f} g {s h}}}} test huddle-1.6 "test of huddle create" -body { huddle get_stripped $folding dd } -result {bb {a b c d} cc {e f g h}} test huddle-1.7 "test of huddle create" -body { huddle get_stripped $folding dd cc } -result {e f g h} test huddle-1.8 "test of huddle create" -body { huddle type $folding dd } -result {dict} test huddle-1.9 "test of huddle create" -body { huddle type $folding dd cc } -result {dict} test huddle-1.10 "test of huddle create" -body { huddle type $folding dd cc g } -result {string} test huddle-2.1 "test of huddle list" -body { set upper [huddle list a b c d] } -result {HUDDLE {L {{s a} {s b} {s c} {s d}}}} test huddle-2.2 "test of huddle list" -body { set upper2 [huddle list e f g h] set folding [huddle list i $upper j k $upper2] } -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}}}}}} test huddle-2.3 "test of huddle list" -body { set folding [huddle list $folding t u] set data_list $folding } -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}}}} test huddle-2.4 "test of huddle list" -body { huddle get $folding 0 } -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}}}}}} test huddle-2.5 "test of huddle list" -body { huddle get $folding 0 1 } -result {HUDDLE {L {{s a} {s b} {s c} {s d}}}} test huddle-2.6 "test of huddle list" -body { huddle get_stripped $folding 0 } -result {i {a b c d} j k {e f g h}} test huddle-2.7 "test of huddle list" -body { huddle get_stripped $folding 0 1 } -result {a b c d} test huddle-2.8 "test of huddle list" -body { huddle type $folding 0 } -result {list} test huddle-2.9 "test of huddle list" -body { huddle type $folding 0 1 } -result {list} test huddle-2.10 "test of huddle list" -body { huddle type $folding 0 1 3 } -result {string} test huddle-2.11 "test of huddle list" -body { huddle get_stripped {HUDDLE {L {{s a} {L {}} {s c}}}} } -result {a {} c} #test huddle-3.1 "test of huddle jsondump" {[info tclversion] >= 8.5} { # # build a huddle container from normal tcl's container(multi rank dict/list) # proc huddle_build {data} { # foreach {key val} $data { # if {$key eq "layers"} { # foreach {l} [dict get $data layers] { # lappend subs [huddle_build $l] # } # set val [eval huddle list $subs] # } # lappend result $key $val # } # return [eval huddle create $result] # } # set fd [open [asset layers.txt] r] # set json1 [read $fd] # close $fd # # set data [json::json2dict $json1] ## set data [huddle_build $data] ## ## set json2 [huddle jsondump $data] ## expr $json1 eq $json2 ## set json2 #} {1} test huddle-3.2 "test of huddle jsondump" -body { huddle jsondump {HUDDLE {L {{L {{s i} {s baa} {s k} {L {{num 1.0} {b true} {s g} {s h}}}}} {s t}}}} } -result {[ [ "i", "baa", "k", [ 1.0, true, "g", "h" ] ], "t" ]} test huddle-3.3 "test of huddle jsondump" -body { 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}}}}}}} set json1 [huddle jsondump $huddle1] set json2 {{ "dd": { "bb": { "a": "baa", "c": "d a" }, "cc": {"g": "h"} }, "ee": { "i": "j", "k": 1, "j": " m\\a" } }} if {$json1 == $json2} { return 1 } else { return 0 } } -result {1} test huddle-3.4 "test of huddle compile" -body { 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}}}}}}} set json1 {{ "dd": { "bb": { "a": "baa", "c": "d a" }, "cc": {"g": "h"} }, "ee": { "i": "j", "k": 1, "j": " m\\a" } }} set data [json::json2dict $json1] set data [huddle compile {dict dd {dict * dict} ee {dict k number * string}} $data] huddle equal $huddle1 $data } -result {1} test huddle-3.5 "test of huddle jsondump - null handling" -body { huddle jsondump {HUDDLE null} } -result {null} test huddle-3.6 "test of huddle jsondump - dict and null handling" -body { huddle jsondump {HUDDLE {D {a {s foo} b null}}} } -result {{ "a": "foo", "b": null }} # ... Tests of addStrings ... # (Requires introspection of parser state) test huddle-4.1 "test of huddle set" -body { huddle set data_dict dd bb a baa } -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}}}}}} test huddle-4.2 "test of huddle remove" -body { set data_dict [huddle remove $data_dict dd cc e] } -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}}}}}} test huddle-4.3 "test of huddle set" -body { huddle set data_list 0 1 baa } -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}}}} test huddle-4.4 "test of huddle remove" -body { set data_list [huddle remove $data_list 0 2] } -result {HUDDLE {L {{L {{s i} {s baa} {s k} {L {{s e} {s f} {s g} {s h}}}}} {s t} {s u}}}} test huddle-4.5 "test of huddle equal" -body { 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}}}}}} } -result 1 test huddle-4.6 "test of huddle equal" -body { 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}}}}}} } -result 0 test huddle-4.7 "test of huddle equal" -body { 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}}}}}} } -result 0 test huddle-4.8 "test of huddle equal" -body { 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}}}} } -result 1 test huddle-4.9 "test of huddle equal" -body { 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}}}} } -result 0 test huddle-4.10 "test of huddle equal" -body { huddle equal $data_list {HUDDLE {L {{L {{s i} {s baa} {s k} {L {{s e} {s f} {s g} {s h}}}}} {s t}}}} } -result 0 test huddle-5.1 "test of huddle boolean" -body { huddle true } -result {HUDDLE {b true}} test huddle-5.2 "test of huddle boolean" -body { huddle false } -result {HUDDLE {b false}} test huddle-6.1 "test of huddle null" -body { huddle null } -result {HUDDLE null} test huddle-7.1 "test of huddle number" -body { huddle number -4.5E-6 } -result {HUDDLE {num -4.5E-6}} test huddle-8.1 "test of complex data structure using the new types: number, boolean and null" -body { huddle create key1 var1 key2 [huddle number 4] key3 [huddle list [huddle null] sadf [huddle true]] } -result {HUDDLE {D {key1 {s var1} key2 {num 4} key3 {L {null {s sadf} {b true}}}}}} test huddle-9.1 "test of huddle exists" -body { set obj [huddle list [huddle create key1 2 key3 4] 1 2 [huddle list 1 2 [huddle list 1 2]] ] huddle exists $obj 0 key1 } -result {1} test huddle-9.2 "test of huddle exists" -body { set obj [huddle list [huddle create key1 2 key3 4] 1 2 [huddle list 1 2 [huddle list 1 2]] ] huddle exists $obj 3 2 1 } -result {1} test huddle-9.1 "test of huddle exists" -body { set obj [huddle list [huddle create key1 2 key3 4] 1 2 [huddle list 1 2 [huddle list 1 2]] ] huddle exists $obj 0 key1 } -result {1} test huddle-9.3 "test of huddle exists" -body { set obj [huddle list [huddle create key1 2 key3 4] 1 2 [huddle list 1 2 [huddle list 1 2]] ] huddle exists $obj 3 3 1 } -result {0} test huddle-10.1 "test of huddle clone" -body { set obj [huddle list item0 item1 [huddle create key0 value0 key1 value1]] huddle clone $obj } -result {HUDDLE {L {{s item0} {s item1} {D {key0 {s value0} key1 {s value1}}}}}} test huddle-11.1 "test of huddle superclass" -body { namespace eval ::new_types::mapping { variable settings set settings { superclass dict publicMethods {mapping} tag !!map isContainer yes } proc mapping {args} { if {[llength $args] % 2} {error {wrong # args: should be "huddle mapping ?key value ...?"}} set resultL {} foreach {key value} $args { lappend resultL $key [argument_to_node $value !!str] } return [wrap [list !!map $resultL]] } } namespace eval ::new_types::str { variable settings set settings { superclass string publicMethods {} isContainer no tag !!str } } huddle addType ::new_types::mapping huddle addType ::new_types::str set a [huddle mapping key1 var1] huddle append a key2 [huddle mapping key3 var3] } -result {HUDDLE {!!map {key1 {!!str var1} key2 {!!map {key3 {!!str var3}}}}}} test huddle-12.0 {ticket [d0e1cf6be1]: jsondump added types} -setup { namespace eval ::map { variable settings { publicMethods {jsondump} isContainer yes tag !!map } } proc ::map::jsondump {obj {offset " "} {newline "\n"} {begin {}}} { # strip huddle and type markers, then ... set data [lindex $obj 1 1] # ... rewrap into the dict the map is an alias for, and dump return [::huddle::jsondump [list HUDDLE [list D $data]] $offset $newline $begin] } huddle addType ::map } -body { huddle jsondump {HUDDLE {!!map {a {s fox} b {b true}}}} } -cleanup { namespace delete ::map } -result {{ "a": "fox", "b": true }} # -------------------------------------------------------------------- if {[info exists selfrun]} { tcltest::cleanupTests } else { testsuiteCleanup } return