131 lines
2.7 KiB
Plaintext
131 lines
2.7 KiB
Plaintext
source [file dirname [info script]]/testing.tcl
|
|
needs cmd tree
|
|
needs cmd ref
|
|
|
|
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 known 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" {
|
|
$pt lappend $n newkey first
|
|
$pt lappend $n newkey second
|
|
$pt lappend $n newkey third
|
|
$pt lappend $n newkey last
|
|
} {first second third last}
|
|
|
|
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}
|
|
|
|
test tree-3.1 "delete nodes" {
|
|
$pt delete node6
|
|
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}
|
|
|
|
test tree-3.2 "can't delete root node" -body {
|
|
$pt delete root
|
|
} -returnCodes error -result {can't delete root node}
|
|
|
|
$pt destroy
|
|
|
|
testreport
|