source: branches/blt4/tester/testtree.tcl @ 2047

Last change on this file since 2047 was 2047, checked in by gah, 11 years ago

update from r6 branch

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