source: trunk/tester/testtree.tcl @ 2068

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

Small fixes for regression tester
File size: 13.9 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 {args}
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# ----------------------------------------------------------------------
122# DESTRUCTOR
123# ----------------------------------------------------------------------
124itcl::body Rappture::Tester::TestTree::destructor {} {
125    foreach id [getLeaves] {
126        itcl::delete object [getTest $id]
127    }
128}
129
130# ----------------------------------------------------------------------
131# CONFIGURATION OPTION: -testdir
132#
133# Location of the directory containing a set of test xml files.
134# Repopulate the tree if -testdir option is changed, but only if
135# -toolxml has already been defined.
136# ----------------------------------------------------------------------
137itcl::configbody Rappture::Tester::TestTree::testdir {
138    if {[file isdirectory $itk_option(-testdir)]} {
139        if {$itk_option(-toolxml) != ""} {
140            populate
141        }
142    } else {
143        error "Test directory \"$itk_option(-testdir)\" does not exist"
144    }
145}
146
147# ----------------------------------------------------------------------
148# CONFIGURATION OPTION: -toolxml
149#
150# Location of the tool.xml for the tool being tested.  Repopulate the
151# tree if -toolxml is changed, but only if -testdir has already been
152# defined.
153# ----------------------------------------------------------------------
154itcl::configbody Rappture::Tester::TestTree::toolxml {
155    if {[file exists $itk_option(-toolxml)]} {
156        if {$itk_option(-testdir) != ""} {
157            populate
158        }
159    } else {
160        error "Tool \"$itk_option(-testdir)\" does not exist"
161    }
162}
163
164# ----------------------------------------------------------------------
165# CONFIGURATION OPTION: -selectcommand
166#
167# Forward the TestTree's selectcommand to the treeview, but tack on the
168# updateLabel method to keep the label refreshed when selection is
169# changed
170# ----------------------------------------------------------------------
171itcl::configbody Rappture::Tester::TestTree::selectcommand {
172    $itk_component(treeview) configure -selectcommand \
173        "[itcl::code $this updateLabel]; $itk_option(-selectcommand)"
174}
175
176# ----------------------------------------------------------------------
177# USAGE getTest ?id?
178#
179# Returns the test object associated with a given treeview node id.  If
180# no id is given, return the test associated with the currently focused
181# node.  Returns empty string if the given id / focused node is a
182# branch node.
183# ----------------------------------------------------------------------
184itcl::body Rappture::Tester::TestTree::getTest {args} {
185    if {[llength $args] == 0} {
186         set id [$itk_component(treeview) index focus]
187    } elseif {[llength $args] == 1} {
188        set id [lindex $args 0]
189    } else {
190        error "wrong # args: should be getTest ?id?"
191    }
192    array set darray [getData $id]
193    if {[lsearch -exact [getLeaves] $id] == -1} {
194        # Return empty string if branch node selected
195        return ""
196    }
197    return $darray(test)
198}
199
200# ----------------------------------------------------------------------
201# USAGE: refresh ?id?
202#
203# Refreshes the result column and any other information which may be
204# added later for the given tree node id.  Mainly needed to update the
205# result from Fail to Pass after regoldenizing a test.  If no id is
206# given, refresh all tests and search the test directory again to check
207# for new tests.
208# ----------------------------------------------------------------------
209itcl::body Rappture::Tester::TestTree::refresh {args} {
210    if {[llength $args] == 0} {
211        foreach id [getLeaves] {
212            refresh $id
213        }
214        populate -noclear
215    } elseif {[llength $args] == 1} {
216        set id [lindex $args 0]
217        if {[lsearch -exact [getLeaves] $id] == -1} {
218            error "given id $id is not a leaf node."
219        }
220        set test [getTest $id]
221        setData $id [list result [$test getResult] test $test]
222    } else {
223        error "wrong # args: should be refresh ?id?"
224    }
225}
226
227# ----------------------------------------------------------------------
228# USAGE: getData <id>
229#
230# Returns a list of key-value pairs representing the column data stored
231# at the tree node with the given id.
232# ----------------------------------------------------------------------
233itcl::body Rappture::Tester::TestTree::getData {id} {
234    return [$itk_component(treeview) entry cget $id -data]
235}
236
237# ----------------------------------------------------------------------
238# USAGE: getLeaves ?id?
239#
240# Returns a list of ids for all tests contained in the tree.  If an
241# optional id is given as an input parameter, then the returned list
242# will contain the ids of all tests that are descendants of the given
243# id.  Tests can only be leaf nodes.
244# ----------------------------------------------------------------------
245itcl::body Rappture::Tester::TestTree::getLeaves {{id 0}} {
246    set clist [$itk_component(treeview) entry children $id]
247    if {$clist == "" && $id == 0} {
248        # Return nothing if tree is empty
249        return ""
250    }
251    if {$clist == ""} {
252        return $id
253    }
254    set tests [list]
255    foreach child $clist {
256        set tests [concat $tests [getLeaves $child]]
257    }
258    return $tests
259}
260
261# ----------------------------------------------------------------------
262# USAGE: getSelected
263#
264# Returns a list ids for all currently selected tests (leaf nodes) and
265# the child tests of any currently selected branch nodes.  Tests can
266# only be leaf nodes in the tree (the ids in the returned list will
267# correspond to leaf nodes only).
268# ----------------------------------------------------------------------
269itcl::body Rappture::Tester::TestTree::getSelected {} {
270    set selection [$itk_component(treeview) curselection]
271    set selectedTests [list]
272    foreach id $selection {
273        foreach node [getLeaves $id] {
274            if {[lsearch -exact $selectedTests $node] == -1} {
275                lappend selectedTests $node
276            }
277        }
278    }
279    return $selectedTests
280}
281
282# ----------------------------------------------------------------------
283# USAGE: populate ?-noclear?
284#
285# Used internally to insert nodes into the treeview for each test xml
286# found in the test directory.  Skips any xml files that do not contain
287# information at path test.label.  Relies on the autocreate treeview
288# option so that branch nodes need not be explicitly created.  Deletes
289# any existing contents unless -noclear is given as an argument.
290# ----------------------------------------------------------------------
291itcl::body Rappture::Tester::TestTree::populate {args} {
292    if {[lsearch $args -noclear] == -1} {
293        foreach id [getLeaves] {
294            itcl::delete object [getTest $id]
295        }
296        $itk_component(treeview) delete 0
297        $itk_component(treeview) selection clearall
298    }
299    # TODO: add an appropriate icon
300    set icon [Rappture::icon molvis-3dorth]
301    # TODO: Descend through subdirectories inside testdir?
302    foreach testxml [glob -nocomplain -directory $itk_option(-testdir) *.xml] {
303        set lib [Rappture::library $testxml]
304        set testpath [$lib get test.label]
305        if {$testpath != "" && \
306            [$itk_component(treeview) find -full $testpath] == ""} {
307            set test [Rappture::Tester::Test ::#auto \
308                $itk_option(-toolxml) $testxml]
309            $itk_component(treeview) insert end $testpath -data \
310                 [list test $test] -icons "$icon $icon" \
311                 -activeicons "$icon $icon"
312        }
313    }
314    $itk_component(treeview) open -recurse root
315    # TODO: Fix width of main treeview column
316    updateLabel
317}
318
319# ----------------------------------------------------------------------
320# USAGE: runSelected
321#
322# Invoked by the run button to run all currently selected tests.
323# After completion, call selectcommand to re-select the newly completed
324# focused node.
325# ----------------------------------------------------------------------
326itcl::body Rappture::Tester::TestTree::runSelected {} {
327    foreach id [$this getSelected] {
328        runTest $id
329    }
330    # Try calling selectcommand with the -refresh option.  If selectcommand
331    # does not accept this argument, then call it with no arguments.
332    if {[catch {eval $itk_option(-selectcommand) -refresh}]} {
333        eval $itk_option(-selectcommand)
334    }
335}
336
337# ----------------------------------------------------------------------
338# USAGE: runTest id
339#
340# Runs the test located at the tree node with the given id.  The id
341# must be a leaf node, because tests may not be located at branch nodes.
342# ----------------------------------------------------------------------
343itcl::body Rappture::Tester::TestTree::runTest {id} {
344    if {[lsearch -exact [getLeaves] $id] == -1} {
345        error "given id $id is not a leaf node"
346    }
347    set test [getTest $id]
348    setData $id [list result Running test $test]
349    $test run
350    setData $id [list result [$test getResult] test $test]
351}
352
353# ----------------------------------------------------------------------
354# USAGE: setData <id> <data>
355#
356# Accepts a node id and a list of key-value pairs.  Stored the list as
357# column data associated with the tree node with the given id.
358# ----------------------------------------------------------------------
359itcl::body Rappture::Tester::TestTree::setData {id data} {
360    $itk_component(treeview) entry configure $id -data $data
361}
362
363# ----------------------------------------------------------------------
364# USAGE: updateLabel
365#
366# Used internally to update the label which indicates how many tests
367# are currently selected.  Also disables the run button if no tests are
368# selected.
369# ----------------------------------------------------------------------
370itcl::body Rappture::Tester::TestTree::updateLabel {} {
371    set n [llength [getSelected]]
372    if {$n == 1} {
373        $itk_component(lSelected) configure -text "1 test selected"
374    } else {
375        $itk_component(lSelected) configure -text "$n tests selected"
376    }
377
378    if {$n > 0} {
379        $itk_component(bRun) configure -state normal
380    } else {
381        $itk_component(bRun) configure -state disabled
382    }
383}
384
Note: See TracBrowser for help on using the repository browser.