package require testing package-or-skip tree section "tree" proc dputs {msg} { #puts $msg } test tree-1.1 "Create tree" { set pt [tree] return 1 } {1} test tree-1.2 "Root node depth" { $pt depth root } {0} test tree-1.3 "Access invalid node" { list [catch { $pt depth bogus } msg] $msg } {1 {key "bogus" not found in dictionary}} test tree-1.4 "Set key/value" { $pt set root key value $pt set root type root $pt set root name rootnode $pt set root values {} $pt get root key } {value} test tree-1.5 "Add child node" { set n [$pt insert root] $pt set $n childkey childvalue $pt set $n type level1type $pt set $n name childnode1 $pt set $n values {label testlabel} $pt get $n childkey } {childvalue} test tree-1.6 "Add child, child node" { set nn [$pt insert $n] $pt set $nn childkey2 childvalue2 $pt set $nn type level2type $pt set $nn name childnode2 $pt set $nn values {label testlabel storage none} $pt get $nn childkey2 } {childvalue2} test tree-1.7 "Key exists true" { $pt keyexists $nn childkey2 } {1} test tree-1.7 "Key exists false" { $pt keyexists $n boguskey } {0} test tree-1.8 "lappend new key" { $pt lappend $n newkey first } {first} test tree-1.9 "lappend existing key" { $pt lappend $n newkey next } {first next} test tree-2.0 "Add more nodes" { set c [$pt insert root] $pt set $c name root.c2 set c [$pt insert root] $pt set $c name root.c3 set c [$pt insert $n] $pt set $c name n.c4 set c [$pt insert $n] $pt set $c name n.c5 set c [$pt insert $c] $pt set $c name n.c5.c6 return 1 } {1} test tree-2.1 "walk dfs" { set result {} dputs "" $pt walk root dfs {action n} { set indent [string repeat " " [$pt depth $n]] if {$action == "enter"} { lappend result [$pt get $n name] dputs "$indent[$pt get $n name]" } } dputs "" set result } {rootnode childnode1 childnode2 n.c4 n.c5 n.c5.c6 root.c2 root.c3} test tree-2.2 "walk dfs exit" { set result {} $pt walk root dfs {action n} { if {$action == "exit"} { lappend result [$pt get $n name] } } set result } {childnode2 n.c4 n.c5.c6 n.c5 childnode1 root.c2 root.c3 rootnode} test tree-2.3 "walk bfs" { set result {} $pt walk root bfs {action n} { if {$action == "enter"} { lappend result [$pt get $n name] } } set result } {rootnode childnode1 root.c2 root.c3 childnode2 n.c4 n.c5 n.c5.c6} $pt destroy