From e68eadfbfe66d350b9656e3a4a91f7520e2bfba4 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Sun, 24 Jan 2010 10:47:03 +1000
Subject: Implement tree package

Similar to tcllib ::struct::tree

------------------------------------------------------------------------
---
 tests/tree.test | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 114 insertions(+)
 create mode 100644 tests/tree.test

(limited to 'tests')

diff --git a/tests/tree.test b/tests/tree.test
new file mode 100644
index 0000000..1b91559
--- /dev/null
+++ b/tests/tree.test
@@ -0,0 +1,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
-- 
cgit v1.1