source: trunk/tester/testtree.tcl @ 2055

Last change on this file since 2055 was 2055, checked in by braffert, 14 years ago

Regression tester: cleaning up and adding comments
File size: 13.2 KB
Line 
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
5#  directory.  In each test xml, a label must be located at the path
6#  test.label.  Test labels may be organized hierarchically by using
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.
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# ======================================================================
17package require Itk
18package require BLT
19package require Rappture
20
21namespace eval Rappture::Tester::TestTree { #forward declaration }
22
23option add *TestTree.font \
24    -*-helvetica-medium-r-normal-*-12-* widgetDefault
25option add *TestTree.codeFont \
26    -*-courier-medium-r-normal-*-12-* widgetDefault
27option add *TestTree.textFont \
28    -*-helvetica-medium-r-normal-*-12-* widgetDefault
29option add *TestTree.boldTextFont \
30    -*-helvetica-bold-r-normal-*-12-* widgetDefault
31
32itcl::class Rappture::Tester::TestTree {
33    inherit itk::Widget
34
35    itk_option define -selectcommand selectCommand SelectCommand ""
36    itk_option define -testdir testDir TestDir ""
37    itk_option define -toolxml toolXml ToolXml ""
38
39    constructor {args} { #defined later }
40    destructor { #defined later }
41
42    public method getTest {args}
43    public method refresh {args}
44
45    protected method getData {id}
46    protected method getLeaves {{id 0}}
47    protected method getSelected {}
48    protected method populate {}
49    protected method runSelected {}
50    protected method runTest {id}
51    protected method setData {id data}
52    protected method updateLabel {}
53
54}
55 
56itk::usual TestTree {
57    keep -background -foreground -font
58}
59
60# ----------------------------------------------------------------------
61# CONSTRUCTOR
62# ----------------------------------------------------------------------
63itcl::body Rappture::Tester::TestTree::constructor {args} {
64    itk_component add scrollbars {
65        Rappture::Scroller $itk_interior.scroller \
66            -xscrollmode auto -yscrollmode auto
67    }
68    itk_component add treeview {
69        blt::treeview $itk_component(scrollbars).treeview -separator | \
70            -autocreate true -selectmode multiple
71    } {
72        keep -foreground -font -cursor
73    }
74    $itk_component(treeview) column insert 0 result -width 75
75    $itk_component(treeview) column insert end test -hide yes
76    $itk_component(scrollbars) contents $itk_component(treeview)
77
78    itk_component add bottomBar {
79        frame $itk_interior.bottomBar
80    }
81    pack $itk_component(bottomBar) -fill x -side bottom
82
83    itk_component add bSelectAll {
84        button $itk_component(bottomBar).bSelectAll -text "Select all" \
85            -command "$itk_component(treeview) selection set 0 end"
86    }
87    pack $itk_component(bSelectAll) -side left
88
89    itk_component add bSelectNone {
90        button $itk_component(bottomBar).bSelectNone -text "Select none" \
91            -command "$itk_component(treeview) selection clearall"
92    }
93    pack $itk_component(bSelectNone) -side left
94
95    itk_component add bRun {
96        button $itk_component(bottomBar).bRun -text "Run" -state disabled \
97            -command [itcl::code $this runSelected]
98    }
99    pack $itk_component(bRun) -side right
100
101    itk_component add lSelected {
102        label $itk_component(bottomBar).lSelected -text "0 tests selected"
103    }
104    pack $itk_component(lSelected) -side right -padx 5
105
106    # TODO: Fix black empty space when columns are shrunk
107
108    pack $itk_component(scrollbars) -side left -expand yes -fill both
109
110    eval itk_initialize $args
111
112    if {$itk_option(-testdir) == ""} {
113        error "no -testdir configuration option given."
114    }
115    if {$itk_option(-toolxml) == ""} {
116        error "no -toolxml configuration option given."
117    }
118}
119
120# ----------------------------------------------------------------------
121# DESTRUCTOR
122# ----------------------------------------------------------------------
123itcl::body Rappture::Tester::TestTree::destructor {} {
124    foreach id [getLeaves] {
125        itcl::delete object [getTest $id]
126    }
127}
128
129# ----------------------------------------------------------------------
130# CONFIGURATION OPTION: -testdir
131#
132# Location of the directory containing a set of test xml files.
133# Repopulate the tree if -testdir option is changed, but only if
134# -toolxml has already been defined.
135# ----------------------------------------------------------------------
136itcl::configbody Rappture::Tester::TestTree::testdir {
137    if {$itk_option(-toolxml) != ""} {
138        populate
139    }
140}
141
142# ----------------------------------------------------------------------
143# CONFIGURATION OPTION: -toolxml
144#
145# Location of the tool.xml for the tool being tested.  Repopulate the
146# tree if -toolxml is changed, but only if -testdir has already been
147# defined.
148itcl::configbody Rappture::Tester::TestTree::toolxml {
149    if {$itk_option(-testdir) != ""} {
150        populate
151    }
152}
153
154# ----------------------------------------------------------------------
155# CONFIGURATION OPTION: -selectcommand
156#
157# Forward the TestTree's selectcommand to the treeview, but tack on the
158# updateLabel method to keep the label refreshed when selection is
159# changed
160# ----------------------------------------------------------------------
161itcl::configbody Rappture::Tester::TestTree::selectcommand {
162    $itk_component(treeview) configure -selectcommand \
163        "[itcl::code $this updateLabel]; $itk_option(-selectcommand)"
164}
165
166# ----------------------------------------------------------------------
167# USAGE getTest ?id?
168#
169# Returns the test object associated with a given treeview node id.  If
170# no id is given, return the test associated with the currently focused
171# node.  Returns empty string if the given id / focused node is a
172# branch node.
173# ----------------------------------------------------------------------
174itcl::body Rappture::Tester::TestTree::getTest {args} {
175    if {[llength $args] == 0} {
176         set id [$itk_component(treeview) index focus]
177    } elseif {[llength $args] == 1} {
178        set id [lindex $args 0]
179    } else {
180        error "wrong # args: should be getTest ?id?"
181    }
182    array set darray [getData $id]
183    if {[lsearch -exact [getLeaves] $id] == -1} {
184        # Return empty string if branch node selected
185        return ""
186    }
187    return $darray(test)
188}
189
190# ----------------------------------------------------------------------
191# USAGE: refresh ?id?
192#
193# Refreshes the result column and any other information which may be
194# added later for the given tree node id.  Mainly needed to update the
195# result from Fail to Pass after regoldenizing a test.  If no id is
196# given, return the test associated with the currently focused node.
197# ----------------------------------------------------------------------
198itcl::body Rappture::Tester::TestTree::refresh {args} {
199    if {[llength $args] == 0} {
200         set id [$itk_component(treeview) index focus]
201    } elseif {[llength $args] == 1} {
202        set id [lindex $args 0]
203    } else {
204        error "wrong # args: should be refresh ?id?"
205    }
206    if {[lsearch -exact [getLeaves] $id] == -1} {
207         error "given id $id is not a leaf node."
208    }
209    set test [getTest $id]
210    setData $id [list result [$test getResult] test $test]
211}
212
213# ----------------------------------------------------------------------
214# USAGE: getData <id>
215#
216# Returns a list of key-value pairs representing the column data stored
217# at the tree node with the given id.
218# ----------------------------------------------------------------------
219itcl::body Rappture::Tester::TestTree::getData {id} {
220    return [$itk_component(treeview) entry cget $id -data]
221}
222
223# ----------------------------------------------------------------------
224# USAGE: getLeaves ?id?
225#
226# Returns a list of ids for all tests contained in the tree.  If an
227# optional id is given as an input parameter, then the returned list
228# will contain the ids of all tests that are descendants of the given
229# id.  Tests can only be leaf nodes.
230# ----------------------------------------------------------------------
231itcl::body Rappture::Tester::TestTree::getLeaves {{id 0}} {
232    set clist [$itk_component(treeview) entry children $id]
233    if {$clist == "" && $id == 0} {
234        # Return nothing if tree is empty
235        return ""
236    }
237    if {$clist == ""} {
238        return $id
239    }
240    set tests [list]
241    foreach child $clist {
242        set tests [concat $tests [getLeaves $child]]
243    }
244    return $tests
245}
246
247# ----------------------------------------------------------------------
248# USAGE: getSelected
249#
250# Returns a list ids for all currently selected tests (leaf nodes) and
251# the child tests of any currently selected branch nodes.  Tests can
252# only be leaf nodes in the tree (the ids in the returned list will
253# correspond to leaf nodes only).
254# ----------------------------------------------------------------------
255itcl::body Rappture::Tester::TestTree::getSelected {} {
256    set selection [$itk_component(treeview) curselection]
257    set selectedTests [list]
258    foreach id $selection {
259        foreach node [getLeaves $id] {
260            if {[lsearch -exact $selectedTests $node] == -1} {
261                lappend selectedTests $node
262            }
263        }
264    }
265    return $selectedTests
266}
267
268# ----------------------------------------------------------------------
269# USAGE: populate
270#
271# Used internally to insert nodes into the treeview for each test xml
272# found in the test directory.  Skips any xml files that do not contain
273# information at path test.label.  Relies on the autocreate treeview
274# option so that branch nodes need not be explicitly created.  Deletes
275# any existing contents.
276# ----------------------------------------------------------------------
277itcl::body Rappture::Tester::TestTree::populate {} {
278    foreach id [getLeaves] {
279        itcl::delete object [getTest $id]
280    }
281    $itk_component(treeview) delete 0
282    # TODO: add an appropriate icon
283    set icon [Rappture::icon molvis-3dorth]
284    # TODO: Descend through subdirectories inside testdir?
285    foreach testxml [glob -nocomplain -directory $itk_option(-testdir) *.xml] {
286        set lib [Rappture::library $testxml]
287        set testpath [$lib get test.label]
288        if {$testpath != ""} {
289            set test [Rappture::Tester::Test ::#auto \
290                $itk_option(-toolxml) $testxml]
291            $itk_component(treeview) insert end $testpath -data \
292                 [list test $test] -icons "$icon $icon" \
293                 -activeicons "$icon $icon"
294        }
295    }
296    $itk_component(treeview) open -recurse root
297    # TODO: Fix width of main treeview column
298}
299
300# ----------------------------------------------------------------------
301# USAGE: runSelected
302#
303# Invoked by the run button to run all currently selected tests.
304# After completion, call selectcommand to re-select the newly completed
305# focused node.
306# ----------------------------------------------------------------------
307itcl::body Rappture::Tester::TestTree::runSelected {} {
308    foreach id [$this getSelected] {
309        runTest $id
310    }
311    # Try calling selectcommand with the -refresh option.  If selectcommand
312    # does not accept this argument, then call it with no arguments.
313    if {[catch {eval $itk_option(-selectcommand) -refresh}]} {
314        eval $itk_option(-selectcommand)
315    }
316}
317
318# ----------------------------------------------------------------------
319# USAGE: runTest id
320#
321# Runs the test located at the tree node with the given id.  The id
322# must be a leaf node, because tests may not be located at branch nodes.
323# ----------------------------------------------------------------------
324itcl::body Rappture::Tester::TestTree::runTest {id} {
325    if {[lsearch -exact [getLeaves] $id] == -1} {
326        error "given id $id is not a leaf node"
327    }
328    set test [getTest $id]
329    setData $id [list result Running test $test]
330    $test run
331    setData $id [list result [$test getResult] test $test]
332}
333
334# ----------------------------------------------------------------------
335# USAGE: setData <id> <data>
336#
337# Accepts a node id and a list of key-value pairs.  Stored the list as
338# column data associated with the tree node with the given id.
339# ----------------------------------------------------------------------
340itcl::body Rappture::Tester::TestTree::setData {id data} {
341    $itk_component(treeview) entry configure $id -data $data
342}
343
344# ----------------------------------------------------------------------
345# USAGE: updateLabel
346#
347# Used internally to update the label which indicates how many tests
348# are currently selected.  Also disables the run button if no tests are
349# selected.
350# ----------------------------------------------------------------------
351itcl::body Rappture::Tester::TestTree::updateLabel {} {
352    set n [llength [getSelected]]
353    if {$n == 1} {
354        $itk_component(lSelected) configure -text "1 test selected"
355    } else {
356        $itk_component(lSelected) configure -text "$n tests selected"
357    }
358
359    if {$n > 0} {
360        $itk_component(bRun) configure -state normal
361    } else {
362        $itk_component(bRun) configure -state disabled
363    }
364}
365
Note: See TracBrowser for help on using the repository browser.