blob: 1b91559b353ab604d7faea757504e7b69ede2805 (
plain)
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
|
package require testing
package require tree
section "tree"
test tree-1.1 "Create tree" {
tree create pt
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 {}
puts ""
pt walk root dfs {action n} {
set indent [string repeat " " [pt depth $n]]
if {$action == "enter"} {
lappend result [pt get $n name]
puts "$indent[pt get $n name]"
}
}
puts ""
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}
tree destroy pt
collect
#pt set root name value
|
