[1963] | 1 | # ---------------------------------------------------------------------- |
---|
| 2 | # COMPONENT: testtree - provides hierarchical view of regression tests |
---|
| 3 | # |
---|
| 4 | # Used to display a collapsible view of all tests found in the test |
---|
[2019] | 5 | # directory. In each test xml, a label must be located at the path |
---|
[1964] | 6 | # test.label. Test labels may be organized hierarchically by using |
---|
[2019] | 7 | # dots to separate components of the test label. The directory |
---|
| 8 | # containing a set of test xml files, as well as the location of the |
---|
| 9 | # new tool.xml must be given as configuration options. |
---|
[1963] | 10 | # ====================================================================== |
---|
| 11 | # AUTHOR: Ben Rafferty, Purdue University |
---|
| 12 | # Copyright (c) 2010 Purdue Research Foundation |
---|
| 13 | # |
---|
| 14 | # See the file "license.terms" for information on usage and |
---|
| 15 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 16 | # ====================================================================== |
---|
| 17 | package require Itk |
---|
| 18 | package require BLT |
---|
| 19 | package require Rappture |
---|
[2017] | 20 | |
---|
[1968] | 21 | namespace eval Rappture::Tester::TestTree { #forward declaration } |
---|
[1963] | 22 | |
---|
[1968] | 23 | option add *TestTree.font \ |
---|
| 24 | -*-helvetica-medium-r-normal-*-12-* widgetDefault |
---|
| 25 | option add *TestTree.codeFont \ |
---|
| 26 | -*-courier-medium-r-normal-*-12-* widgetDefault |
---|
| 27 | option add *TestTree.textFont \ |
---|
| 28 | -*-helvetica-medium-r-normal-*-12-* widgetDefault |
---|
| 29 | option add *TestTree.boldTextFont \ |
---|
| 30 | -*-helvetica-bold-r-normal-*-12-* widgetDefault |
---|
| 31 | |
---|
| 32 | itcl::class Rappture::Tester::TestTree { |
---|
[1964] | 33 | inherit itk::Widget |
---|
[1963] | 34 | |
---|
[2019] | 35 | constructor {args} { #defined later } |
---|
[2055] | 36 | destructor { #defined later } |
---|
[1964] | 37 | |
---|
[2077] | 38 | public method add {args} |
---|
| 39 | public method clear {} |
---|
| 40 | public method curselection {} |
---|
[2019] | 41 | |
---|
[2077] | 42 | protected method _getLeaves {{id 0}} |
---|
| 43 | protected method _getTest {id} |
---|
| 44 | protected method _refresh {args} |
---|
[1967] | 45 | |
---|
[2077] | 46 | # add support for a spinning icon |
---|
| 47 | proc spinner {op} |
---|
| 48 | |
---|
| 49 | private common spinner |
---|
| 50 | set spinner(frames) 8 |
---|
| 51 | set spinner(current) 0 |
---|
| 52 | set spinner(pending) "" |
---|
| 53 | set spinner(uses) 0 |
---|
| 54 | |
---|
| 55 | for {set n 0} {$n < $spinner(frames)} {incr n} { |
---|
| 56 | set spinner(frame$n) [Rappture::icon circle-ball[expr {$n+1}]] |
---|
| 57 | } |
---|
| 58 | set spinner(image) [image create photo -width [image width $spinner(frame0)] -height [image height $spinner(frame0)]] |
---|
[1963] | 59 | } |
---|
[1967] | 60 | |
---|
[1963] | 61 | itk::usual TestTree { |
---|
| 62 | keep -background -foreground -font |
---|
| 63 | } |
---|
| 64 | |
---|
[1966] | 65 | # ---------------------------------------------------------------------- |
---|
| 66 | # CONSTRUCTOR |
---|
| 67 | # ---------------------------------------------------------------------- |
---|
[1968] | 68 | itcl::body Rappture::Tester::TestTree::constructor {args} { |
---|
[1967] | 69 | itk_component add scrollbars { |
---|
| 70 | Rappture::Scroller $itk_interior.scroller \ |
---|
| 71 | -xscrollmode auto -yscrollmode auto |
---|
| 72 | } |
---|
[2077] | 73 | pack $itk_component(scrollbars) -expand yes -fill both |
---|
| 74 | |
---|
[1963] | 75 | itk_component add treeview { |
---|
[2012] | 76 | blt::treeview $itk_component(scrollbars).treeview -separator | \ |
---|
[2077] | 77 | -autocreate true -selectmode multiple \ |
---|
| 78 | -icons [list [Rappture::icon folder] [Rappture::icon folder2]] \ |
---|
| 79 | -activeicons "" |
---|
[1966] | 80 | } { |
---|
[1968] | 81 | keep -foreground -font -cursor |
---|
[2077] | 82 | keep -selectcommand |
---|
[1963] | 83 | } |
---|
[2077] | 84 | $itk_component(treeview) column insert 0 result -title "Result" |
---|
[2019] | 85 | $itk_component(treeview) column insert end test -hide yes |
---|
[2077] | 86 | $itk_component(treeview) column configure treeView -justify left -title "Test Case" |
---|
[2139] | 87 | $itk_component(treeview) sort configure -mode dictionary -column treeView |
---|
| 88 | $itk_component(treeview) sort auto yes |
---|
| 89 | |
---|
[1967] | 90 | $itk_component(scrollbars) contents $itk_component(treeview) |
---|
[1964] | 91 | |
---|
| 92 | itk_component add bottomBar { |
---|
| 93 | frame $itk_interior.bottomBar |
---|
| 94 | } |
---|
[2077] | 95 | pack $itk_component(bottomBar) -fill x -side bottom -pady {8 0} |
---|
[1964] | 96 | |
---|
[2077] | 97 | itk_component add selLabel { |
---|
| 98 | label $itk_component(bottomBar).selLabel -anchor w -text "Select:" |
---|
| 99 | } |
---|
| 100 | pack $itk_component(selLabel) -side left |
---|
| 101 | |
---|
[1964] | 102 | itk_component add bSelectAll { |
---|
[2077] | 103 | button $itk_component(bottomBar).bSelectAll -text "All" \ |
---|
[1964] | 104 | -command "$itk_component(treeview) selection set 0 end" |
---|
| 105 | } |
---|
| 106 | pack $itk_component(bSelectAll) -side left |
---|
| 107 | |
---|
| 108 | itk_component add bSelectNone { |
---|
[2077] | 109 | button $itk_component(bottomBar).bSelectNone -text "None" \ |
---|
[1964] | 110 | -command "$itk_component(treeview) selection clearall" |
---|
| 111 | } |
---|
| 112 | pack $itk_component(bSelectNone) -side left |
---|
| 113 | |
---|
| 114 | |
---|
| 115 | eval itk_initialize $args |
---|
[1963] | 116 | } |
---|
| 117 | |
---|
[2055] | 118 | # ---------------------------------------------------------------------- |
---|
| 119 | # DESTRUCTOR |
---|
| 120 | # ---------------------------------------------------------------------- |
---|
| 121 | itcl::body Rappture::Tester::TestTree::destructor {} { |
---|
[2077] | 122 | clear |
---|
[2055] | 123 | } |
---|
[2034] | 124 | |
---|
[2019] | 125 | # ---------------------------------------------------------------------- |
---|
[2077] | 126 | # USAGE: add ?<testObj> <testObj> ...? |
---|
[2055] | 127 | # |
---|
[2077] | 128 | # Adds one or more Test objects to the tree shown in this viewer. |
---|
| 129 | # Once added, these objects become property of this widget and |
---|
| 130 | # are destroyed when the widget is cleared or deleted. |
---|
[2019] | 131 | # ---------------------------------------------------------------------- |
---|
[2077] | 132 | itcl::body Rappture::Tester::TestTree::add {args} { |
---|
| 133 | set icon [Rappture::icon testcase] |
---|
| 134 | |
---|
| 135 | foreach obj $args { |
---|
| 136 | if {[catch {$obj isa Rappture::Tester::Test} valid] || !$valid} { |
---|
| 137 | error "bad value \"$obj\": should be Test object" |
---|
[2068] | 138 | } |
---|
[2077] | 139 | |
---|
| 140 | # add each Test object into the tree |
---|
| 141 | set testpath [$obj getTestInfo test.label] |
---|
| 142 | set n [$itk_component(treeview) insert end $testpath \ |
---|
| 143 | -data [list test $obj] -icons [list $icon $icon]] |
---|
| 144 | |
---|
| 145 | # tag this node so we can find it easily later |
---|
| 146 | $itk_component(treeview) tag add $obj $n |
---|
| 147 | |
---|
| 148 | # monitor state changes on the object |
---|
| 149 | $obj configure -notifycommand [itcl::code $this _refresh] |
---|
[2031] | 150 | } |
---|
[1964] | 151 | } |
---|
[1963] | 152 | |
---|
[2055] | 153 | # ---------------------------------------------------------------------- |
---|
[2077] | 154 | # USAGE: clear |
---|
[2055] | 155 | # |
---|
[2077] | 156 | # Clears the contents of the tree so that it's completely empty. |
---|
| 157 | # All Test objects stored internally are destroyed. |
---|
[2068] | 158 | # ---------------------------------------------------------------------- |
---|
[2077] | 159 | itcl::body Rappture::Tester::TestTree::clear {} { |
---|
| 160 | foreach id [_getLeaves] { |
---|
| 161 | itcl::delete object [_getTest $id] |
---|
[2031] | 162 | } |
---|
[2077] | 163 | $itk_component(treeview) delete 0 |
---|
[2019] | 164 | } |
---|
| 165 | |
---|
| 166 | # ---------------------------------------------------------------------- |
---|
[2077] | 167 | # USAGE: curselection |
---|
[2055] | 168 | # |
---|
[2077] | 169 | # Returns a list ids for all currently selected tests (leaf nodes) and |
---|
| 170 | # the child tests of any currently selected branch nodes. Tests can |
---|
| 171 | # only be leaf nodes in the tree (the ids in the returned list will |
---|
| 172 | # correspond to leaf nodes only). |
---|
[2019] | 173 | # ---------------------------------------------------------------------- |
---|
[2077] | 174 | itcl::body Rappture::Tester::TestTree::curselection {} { |
---|
| 175 | set rlist "" |
---|
| 176 | foreach id [$itk_component(treeview) curselection] { |
---|
| 177 | foreach node [_getLeaves $id] { |
---|
| 178 | catch {unset data} |
---|
| 179 | array set data [$itk_component(treeview) entry cget $node -data] |
---|
| 180 | |
---|
| 181 | if {[lsearch -exact $rlist $data(test)] < 0} { |
---|
| 182 | lappend rlist $data(test) |
---|
| 183 | } |
---|
| 184 | } |
---|
| 185 | } |
---|
| 186 | return $rlist |
---|
[1966] | 187 | } |
---|
| 188 | |
---|
[1963] | 189 | # ---------------------------------------------------------------------- |
---|
[2077] | 190 | # USAGE _getTest <nodeId> |
---|
[1963] | 191 | # |
---|
[2019] | 192 | # Returns the test object associated with a given treeview node id. If |
---|
| 193 | # no id is given, return the test associated with the currently focused |
---|
| 194 | # node. Returns empty string if the given id / focused node is a |
---|
| 195 | # branch node. |
---|
[1963] | 196 | # ---------------------------------------------------------------------- |
---|
[2077] | 197 | itcl::body Rappture::Tester::TestTree::_getTest {id} { |
---|
| 198 | if {[lsearch -exact [_getLeaves] $id] < 0} { |
---|
[2019] | 199 | # Return empty string if branch node selected |
---|
| 200 | return "" |
---|
[1967] | 201 | } |
---|
[2077] | 202 | array set darray [$itk_component(treeview) entry cget $id -data] |
---|
[2019] | 203 | return $darray(test) |
---|
[1963] | 204 | } |
---|
| 205 | |
---|
| 206 | # ---------------------------------------------------------------------- |
---|
[2077] | 207 | # USAGE: _refresh ?<testObj> <testObj> ...? |
---|
[1963] | 208 | # |
---|
[2077] | 209 | # Invoked whenever the state of a <testObj> changes. Finds the |
---|
| 210 | # corresponding entry in the tree and updates the "Result" column |
---|
| 211 | # to show the new status. |
---|
[2019] | 212 | # ---------------------------------------------------------------------- |
---|
[2077] | 213 | itcl::body Rappture::Tester::TestTree::_refresh {args} { |
---|
| 214 | foreach obj $args { |
---|
| 215 | set n [$itk_component(treeview) index $obj] |
---|
| 216 | if {$n ne ""} { |
---|
| 217 | catch {unset data} |
---|
| 218 | array set data [$itk_component(treeview) entry cget $n -data] |
---|
| 219 | |
---|
| 220 | # getting rid of a spinner? then drop it |
---|
| 221 | if {[info exists data(result)] |
---|
| 222 | && $data(result) == "@$spinner(image)"} { |
---|
| 223 | spinner drop |
---|
| 224 | } |
---|
| 225 | |
---|
| 226 | # plug in the new icon |
---|
| 227 | switch -- [$obj getResult] { |
---|
| 228 | Pass { set data(result) "@[Rappture::icon pass16]" } |
---|
| 229 | Fail { set data(result) "@[Rappture::icon fail16]" } |
---|
[2080] | 230 | Waiting { set data(result) "@[Rappture::icon wait16]" } |
---|
[2077] | 231 | Running { set data(result) "@[spinner use]" } |
---|
| 232 | default { set data(result) "" } |
---|
| 233 | } |
---|
| 234 | $itk_component(treeview) entry configure $n -data [array get data] |
---|
[2080] | 235 | |
---|
| 236 | # if the node that's changed is selected, invoke the |
---|
| 237 | # -selectcommand code so the GUI will react to the new state |
---|
| 238 | if {[$itk_component(treeview) selection includes $n]} { |
---|
| 239 | set cmd [$itk_component(treeview) cget -selectcommand] |
---|
| 240 | if {[string length $cmd] > 0} { |
---|
| 241 | uplevel #0 $cmd |
---|
| 242 | } |
---|
| 243 | } |
---|
[2068] | 244 | } |
---|
[2019] | 245 | } |
---|
| 246 | } |
---|
| 247 | |
---|
| 248 | # ---------------------------------------------------------------------- |
---|
[2077] | 249 | # USAGE: _getLeaves ?id? |
---|
[2019] | 250 | # |
---|
[1963] | 251 | # Returns a list of ids for all tests contained in the tree. If an |
---|
| 252 | # optional id is given as an input parameter, then the returned list |
---|
| 253 | # will contain the ids of all tests that are descendants of the given |
---|
[2019] | 254 | # id. Tests can only be leaf nodes. |
---|
[1963] | 255 | # ---------------------------------------------------------------------- |
---|
[2077] | 256 | itcl::body Rappture::Tester::TestTree::_getLeaves {{id 0}} { |
---|
[1963] | 257 | set clist [$itk_component(treeview) entry children $id] |
---|
| 258 | if {$clist == "" && $id == 0} { |
---|
| 259 | # Return nothing if tree is empty |
---|
| 260 | return "" |
---|
| 261 | } |
---|
| 262 | if {$clist == ""} { |
---|
| 263 | return $id |
---|
| 264 | } |
---|
| 265 | set tests [list] |
---|
| 266 | foreach child $clist { |
---|
[2077] | 267 | set tests [concat $tests [_getLeaves $child]] |
---|
[1963] | 268 | } |
---|
| 269 | return $tests |
---|
| 270 | } |
---|
| 271 | |
---|
| 272 | # ---------------------------------------------------------------------- |
---|
[2077] | 273 | # USAGE: spinner use|drop|next |
---|
[1963] | 274 | # |
---|
[2077] | 275 | # Used to update the spinner icon that represents running test cases. |
---|
| 276 | # The "use" option returns the spinner icon and starts the animation, |
---|
| 277 | # if it isn't already running. The "drop" operation lets go of the |
---|
| 278 | # spinner. If nobody is using it, the animation stops. The "next" |
---|
| 279 | # option is used internally to change the animation to the next frame. |
---|
[1963] | 280 | # ---------------------------------------------------------------------- |
---|
[2077] | 281 | itcl::body Rappture::Tester::TestTree::spinner {op} { |
---|
| 282 | switch -- $op { |
---|
| 283 | use { |
---|
| 284 | if {$spinner(pending) == ""} { |
---|
| 285 | set spinner(current) 0 |
---|
| 286 | set spinner(pending) [after 100 Rappture::Tester::TestTree::spinner next] |
---|
[1963] | 287 | } |
---|
[2077] | 288 | incr spinner(uses) |
---|
| 289 | return $spinner(image) |
---|
[1963] | 290 | } |
---|
[2077] | 291 | drop { |
---|
| 292 | if {[incr spinner(uses) -1] <= 0} { |
---|
| 293 | after cancel $spinner(pending) |
---|
| 294 | set spinner(pending) "" |
---|
| 295 | set spinner(uses) 0 |
---|
| 296 | } |
---|
| 297 | } |
---|
| 298 | next { |
---|
| 299 | set n $spinner(current) |
---|
| 300 | $spinner(image) copy $spinner(frame$n) |
---|
[1963] | 301 | |
---|
[2077] | 302 | # go to the next frame |
---|
| 303 | if {[incr spinner(current)] >= $spinner(frames)} { |
---|
| 304 | set spinner(current) 0 |
---|
| 305 | } |
---|
| 306 | |
---|
| 307 | # update again after a short delay |
---|
| 308 | set spinner(pending) [after 100 Rappture::Tester::TestTree::spinner next] |
---|
[2068] | 309 | } |
---|
[2077] | 310 | default { |
---|
| 311 | error "bad option \"$op\": should be use, drop, next" |
---|
[2019] | 312 | } |
---|
| 313 | } |
---|
[2013] | 314 | } |
---|