tests/tree.test


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

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 6
	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