tests/tree.test

   1 source [file dirname [info script]]/testing.tcl
   2 needs cmd tree
   3 needs cmd ref
   4
   5 proc dputs {msg} {
   6         #puts $msg
   7 }
   8
   9 test tree-1.1 "Create tree" {
  10         set pt [tree]
  11         return 1
  12 } {1}
  13
  14 test tree-1.2 "Root node depth" {
  15         $pt depth root
  16 } {0}
  17
  18 test tree-1.3 "Access invalid node" {
  19         list [catch {
  20                 $pt depth bogus
  21         } msg] $msg
  22 } {1 {key "bogus" not known in dictionary}}
  23
  24 test tree-1.4 "Set key/value" {
  25         $pt set root key value
  26         $pt set root type root
  27         $pt set root name rootnode
  28         $pt set root values {}
  29         $pt get root key
  30 } {value}
  31
  32 test tree-1.5 "Add child node" {
  33         set n [$pt insert root]
  34         $pt set $n childkey childvalue
  35         $pt set $n type level1type
  36         $pt set $n name childnode1
  37         $pt set $n values {label testlabel}
  38         $pt get $n childkey
  39 } {childvalue}
  40
  41 test tree-1.6 "Add child, child node" {
  42         set nn [$pt insert $n]
  43         $pt set $nn childkey2 childvalue2
  44         $pt set $nn type level2type
  45         $pt set $nn name childnode2
  46         $pt set $nn values {label testlabel storage none}
  47         $pt get $nn childkey2
  48 } {childvalue2}
  49
  50 test tree-1.7 "Key exists true" {
  51         $pt keyexists $nn childkey2
  52 } {1}
  53
  54 test tree-1.7 "Key exists false" {
  55         $pt keyexists $n boguskey
  56 } {0}
  57
  58 test tree-1.8 "lappend" {
  59         $pt lappend $n newkey first
  60         $pt lappend $n newkey second
  61         $pt lappend $n newkey third
  62         $pt lappend $n newkey last
  63 } {first second third last}
  64
  65 test tree-2.0 "Add more nodes" {
  66         set c [$pt insert root]
  67         $pt set $c name root.c2
  68         set c [$pt insert root]
  69         $pt set $c name root.c3
  70         set c [$pt insert $n]
  71         $pt set $c name n.c4
  72         set c [$pt insert $n]
  73         $pt set $c name n.c5
  74         set c [$pt insert $c]
  75         $pt set $c name n.c5.c6
  76         return 1
  77 } {1}
  78
  79 test tree-2.1 "walk dfs" {
  80         set result {}
  81         dputs ""
  82         $pt walk root dfs {action n} {
  83                 set indent [string repeat "  " [$pt depth $n]]
  84                 if {$action == "enter"} {
  85                         lappend result [$pt get $n name]
  86                         dputs "$indent[$pt get $n name]"
  87                 }
  88         }
  89         dputs ""
  90         set result
  91 } {rootnode childnode1 childnode2 n.c4 n.c5 n.c5.c6 root.c2 root.c3}
  92
  93 test tree-2.2 "walk dfs exit" {
  94         set result {}
  95         $pt walk root dfs {action n} {
  96                 if {$action == "exit"} {
  97                         lappend result [$pt get $n name]
  98                 }
  99         }
 100         set result
 101 } {childnode2 n.c4 n.c5.c6 n.c5 childnode1 root.c2 root.c3 rootnode}
 102
 103 test tree-2.3 "walk bfs" {
 104         set result {}
 105         $pt walk root bfs {action n} {
 106                 if {$action == "enter"} {
 107                         lappend result [$pt get $n name]
 108                 }
 109         }
 110         set result
 111 } {rootnode childnode1 root.c2 root.c3 childnode2 n.c4 n.c5 n.c5.c6}
 112
 113 test tree-3.1 "delete nodes" {
 114         $pt delete node6
 115         set result {}
 116         $pt walk root bfs {action n} {
 117                 if {$action == "enter"} {
 118                         lappend result [$pt get $n name]
 119                 }
 120         }
 121         set result
 122 } {rootnode childnode1 root.c2 root.c3 childnode2 n.c4}
 123
 124 test tree-3.2 "can't delete root node" -body {
 125         $pt delete root
 126 } -returnCodes error -result {can't delete root node}
 127
 128 $pt destroy
 129
 130 testreport