source: trunk/tester/testtree.tcl @ 2050

Last change on this file since 2050 was 2050, checked in by gah, 13 years ago

fixes for tester

File size: 12.3 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                 -activeicons "$icon $icon"
272        }
273    }
274    $itk_component(treeview) open -recurse root
275    # TODO: Fix width of main treeview column
276}
277
278# ----------------------------------------------------------------------
279# USAGE: runSelected
280#
281# Invoked by the run button to run all currently selected tests.
282# After completion, call selectcommand to re-select the newly completed
283# focused node.
284# ----------------------------------------------------------------------
285itcl::body Rappture::Tester::TestTree::runSelected {} {
286    foreach id [$this getSelected] {
287        runTest $id
288    }
289    eval $itk_option(-selectcommand) -refresh
290}
291
292# ----------------------------------------------------------------------
293# USAGE: runTest id
294#
295# Runs the test located at the tree node with the given id.  The id
296# must be a leaf node, because tests may not be located at branch nodes.
297# ----------------------------------------------------------------------
298itcl::body Rappture::Tester::TestTree::runTest {id} {
299    if {[lsearch -exact [getLeaves] $id] == -1} {
300        error "given id $id is not a leaf node"
301    }
302    set test [getTest $id]
303    setData $id [list result Running test $test]
304    $test run
305    setData $id [list result [$test getResult] test $test]
306}
307
308# ----------------------------------------------------------------------
309# USAGE: setData <id> <data>
310#
311# Accepts a node id and a list of key-value pairs.  Stored the list as
312# column data associated with the tree node with the given id.
313# ----------------------------------------------------------------------
314itcl::body Rappture::Tester::TestTree::setData {id data} {
315    $itk_component(treeview) entry configure $id -data $data
316}
317
318# ----------------------------------------------------------------------
319# USAGE: updateLabel
320#
321# Used internally to update the label which indicates how many tests
322# are currently selected.  Also disables the run button if no tests are
323# selected.
324# ----------------------------------------------------------------------
325itcl::body Rappture::Tester::TestTree::updateLabel {} {
326    set n [llength [getSelected]]
327    if {$n == 1} {
328        $itk_component(lSelected) configure -text "1 test selected"
329    } else {
330        $itk_component(lSelected) configure -text "$n tests selected"
331    }
332
333    if {$n > 0} {
334        $itk_component(bRun) configure -state normal
335    } else {
336        $itk_component(bRun) configure -state disabled
337    }
338}
339
Note: See TracBrowser for help on using the repository browser.