huddle_test.tcl

# -*- tcl -*-
# huddle.test:  tests for the huddle library.
#
# Copyright (c) 2008 by KATO Kanryu <kanryu6@users.sourceforge.net>
# 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.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 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 [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 {{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}


# ... 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}}}}}}



if [info exists selfrun] {
    tcltest::cleanupTests
} else {
    testsuiteCleanup
}