Attachment "huddle.test" to
ticket [3536709fff]
added by
ethanp
2012-06-21 03:06:51.
# -*- tcl -*-
# huddle.test: tests for the huddle library.
#
# Copyright (c) 2008 by KATO Kanryu <[email protected]>
# All rights reserved.
#
if {[lsearch [namespace children] ::tcltest] == -1} {
# single test
set selfrun 1
lappend auto_path [pwd]
package require tcltest
namespace import ::tcltest::*
puts [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.3
testsNeedTcltest 1.0
if {$::tcl_version < 8.5} {
if {[catch {package require dict}]} {
puts " Aborting the tests found in \"[file tail [info script]]\""
puts " Requiring dict package, not found."
return
}
}
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 gets $folding dd
} -result {bb {a b c d} cc {e f g h}}
test huddle-1.7 "test of huddle create" -body {
huddle gets $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-1.11 "test of huddle create" -body {
set simple [huddle create a b]
} -result {HUDDLE {D {a {s b}}}}
test huddle-1.12 "test of huddle create" -body {
huddle get $simple a
} -result {HUDDLE {s b}}
test huddle-1.11 "test of huddle create" -body {
huddle keys $folding
} -result {dd ee}
test huddle-1.1.1 "test of huddle create" -body {
set upper [huddle create {a a} b {c c} d]
} -result {HUDDLE {D {{a a} {s b} {c c} {s d}}}}
test huddle-1.1.2 "test of huddle create" -body {
set upper2 [huddle create e f g h]
set upper3 [huddle create {i i} j k l]
set folding [huddle create bb $upper {c c} $upper2]
} -result {HUDDLE {D {bb {D {{a a} {s b} {c c} {s d}}} {c c} {D {e {s f} g {s h}}}}}}
test huddle-1.1.3 "test of huddle create" -body {
set folding [huddle create {d d} $folding ee $upper3]
} -result {HUDDLE {D {{d d} {D {bb {D {{a a} {s b} {c c} {s d}}} {c c} {D {e {s f} g {s h}}}}} ee {D {{i i} {s j} k {s l}}}}}}
test huddle-1.1.4 "test of huddle create" -body {
huddle get $folding {d d}
} -result {HUDDLE {D {bb {D {{a a} {s b} {c c} {s d}}} {c c} {D {e {s f} g {s h}}}}}}
test huddle-1.1.5 "test of huddle create" -body {
huddle get $folding {d d} {c c}
} -result {HUDDLE {D {e {s f} g {s h}}}}
test huddle-1.1.6 "test of huddle create" -body {
huddle gets $folding {d d}
} -result {bb {{a a} b {c c} d} {c c} {e f g h}}
test huddle-1.1.7 "test of huddle create" -body {
huddle gets $folding {d d} {c c}
} -result {e f g h}
test huddle-1.1.8 "test of huddle create" -body {
huddle type $folding {d d}
} -result {dict}
test huddle-1.1.9 "test of huddle create" -body {
huddle type $folding {d d} {c c}
} -result {dict}
test huddle-1.1.10 "test of huddle create" -body {
huddle type $folding {d d} {c c} g
} -result {string}
test huddle-1.1.11 "test of huddle create" -body {
set simple [huddle create {a a} b]
} -result {HUDDLE {D {{a a} {s b}}}}
test huddle-1.1.12 "test of huddle create" -body {
huddle get $simple {a a}
} -result {HUDDLE {s b}}
test huddle-1.1.13 "test of huddle create" -body {
huddle keys $folding
} -result {{d d} ee}
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 gets $folding 0
} -result {i {a b c d} j k {e f g h}}
test huddle-2.7 "test of huddle list" -body {
huddle gets $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 strip {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 [file join [file dirname [info script]] 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 {{s 1.0} {s true} {s g} {s h}}}}} {s t}}}}
} -result {[
[
"i",
"baa",
"k",
[
1.0,
true,
"g",
"h"
]
],
"t"
]}
if { [package vcompare [package provide Tcl] 8.5] > 0 } {
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 {s 1} j {s { m\a}}}}}}}
set json1 [huddle jsondump $huddle1]
set json2 {{
"dd": {
"bb": {
"a": "baa",
"c": "d\na"
},
"cc": {"g": "h"}
},
"ee": {
"i": "j",
"k": 1,
"j": " m\\a"
}
}}
if {$json1 == $json2} {return 1}
set data [json::json2dict $json1]
set data [huddle compile {dict dd {dict * dict} ee dict} $data]
huddle equal $huddle1 $data
} -result {1}
}
# ... 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
# ... Tests of addStrings ...
# (Requires introspection of parser state)
if [info exists selfrun] {
tcltest::cleanupTests
} else {
testsuiteCleanup
}
