Changeset 2077 for trunk


Ignore:
Timestamp:
Feb 1, 2011, 5:37:45 PM (14 years ago)
Author:
mmc
Message:

Some preliminary changes toward a new way of exploring test results.

Location:
trunk/tester
Files:
12 added
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/tester/example/fermi_broken.tcl

    r1963 r2077  
    2929set dE [expr {0.005*($Emax-$Emin)}]
    3030
     31# take a while and give some output along the way
     32puts "Taking a while to run..."
     33after 2000
     34puts "making some progress"
     35after 2000
     36puts "a little more"
     37after 2000
     38puts "almost there"
     39after 2000
     40puts "done"
     41
    3142# Label output graph with title, x-axis label,
    3243# y-axis lable, and y-axis units

  • trunk/tester/tclIndex

    r2068 r2077  
    77# a script that loads the command.
    88
    9 set auto_index(::Rappture::Analyzer) [list source [file join $dir analyzer.tcl]]
    10 set auto_index(::Rappture::Analyzer::constructor) [list source [file join $dir analyzer.tcl]]
    11 set auto_index(::Rappture::Analyzer::destructor) [list source [file join $dir analyzer.tcl]]
    12 set auto_index(::Rappture::Analyzer::simulate) [list source [file join $dir analyzer.tcl]]
    13 set auto_index(::Rappture::Analyzer::reset) [list source [file join $dir analyzer.tcl]]
    14 set auto_index(::Rappture::Analyzer::load) [list source [file join $dir analyzer.tcl]]
    15 set auto_index(::Rappture::Analyzer::clear) [list source [file join $dir analyzer.tcl]]
    16 set auto_index(::Rappture::Analyzer::_simState) [list source [file join $dir analyzer.tcl]]
    17 set auto_index(::Rappture::Analyzer::_simOutput) [list source [file join $dir analyzer.tcl]]
    18 set auto_index(::Rappture::Analyzer::_resultTooltip) [list source [file join $dir analyzer.tcl]]
    19 set auto_index(::Rappture::Analyzer::_fixSimControl) [list source [file join $dir analyzer.tcl]]
    20 set auto_index(::Rappture::Analyzer::_fixNotebook) [list source [file join $dir analyzer.tcl]]
    21 set auto_index(::Rappture::Analyzer::_isPdbTrajectory) [list source [file join $dir analyzer.tcl]]
    22 set auto_index(::Rappture::Analyzer::_isLammpsTrajectory) [list source [file join $dir analyzer.tcl]]
    23 set auto_index(::Rappture::Analyzer::_pdbToSequence) [list source [file join $dir analyzer.tcl]]
    24 set auto_index(::Rappture::Analyzer::_lammpsToSequence) [list source [file join $dir analyzer.tcl]]
    25 set auto_index(::Rappture::Analyzer::_trajToSequence) [list source [file join $dir analyzer.tcl]]
    26 set auto_index(::Rappture::Analyzer::simcontrol) [list source [file join $dir analyzer.tcl]]
    27 set auto_index(::Rappture::Analyzer::notebookpage) [list source [file join $dir analyzer.tcl]]
    28 set auto_index(::Rappture::Tester::Test) [list source [file join $dir test.tcl]]
    29 set auto_index(::Rappture::Tester::Test::constructor) [list source [file join $dir test.tcl]]
    30 set auto_index(::Rappture::Tester::Test::destructor) [list source [file join $dir test.tcl]]
    31 set auto_index(::Rappture::Tester::Test::getAdded) [list source [file join $dir test.tcl]]
    32 set auto_index(::Rappture::Tester::Test::getDiffs) [list source [file join $dir test.tcl]]
    33 set auto_index(::Rappture::Tester::Test::getInputs) [list source [file join $dir test.tcl]]
    34 set auto_index(::Rappture::Tester::Test::getMissing) [list source [file join $dir test.tcl]]
    35 set auto_index(::Rappture::Tester::Test::getOutputs) [list source [file join $dir test.tcl]]
    36 set auto_index(::Rappture::Tester::Test::getResult) [list source [file join $dir test.tcl]]
    37 set auto_index(::Rappture::Tester::Test::getRunfile) [list source [file join $dir test.tcl]]
    38 set auto_index(::Rappture::Tester::Test::getRunobj) [list source [file join $dir test.tcl]]
    39 set auto_index(::Rappture::Tester::Test::getTestxml) [list source [file join $dir test.tcl]]
    40 set auto_index(::Rappture::Tester::Test::getTestobj) [list source [file join $dir test.tcl]]
    41 set auto_index(::Rappture::Tester::Test::hasRan) [list source [file join $dir test.tcl]]
    42 set auto_index(::Rappture::Tester::Test::regoldenize) [list source [file join $dir test.tcl]]
    43 set auto_index(::Rappture::Tester::Test::run) [list source [file join $dir test.tcl]]
    44 set auto_index(::Rappture::Tester::Test::added) [list source [file join $dir test.tcl]]
    45 set auto_index(::Rappture::Tester::Test::compareElements) [list source [file join $dir test.tcl]]
    46 set auto_index(::Rappture::Tester::Test::diffs) [list source [file join $dir test.tcl]]
    47 set auto_index(::Rappture::Tester::Test::makeDriver) [list source [file join $dir test.tcl]]
    48 set auto_index(::Rappture::Tester::Test::merge) [list source [file join $dir test.tcl]]
    49 set auto_index(::Rappture::Tester::Test::missing) [list source [file join $dir test.tcl]]
    509set auto_index(::Rappture::ResultsPage) [list source [file join $dir resultspage.tcl]]
    5110set auto_index(::Rappture::ResultsPage::constructor) [list source [file join $dir resultspage.tcl]]
    … …  
    6221set auto_index(::Rappture::ResultsPage::_reorder) [list source [file join $dir resultspage.tcl]]
    6322set auto_index(::Rappture::ResultsPage::resultset) [list source [file join $dir resultspage.tcl]]
    64 set auto_index(::Rappture::Tester::TestBuilder) [list source [file join $dir testbuilder.tcl]]
    65 set auto_index(::Rappture::Tester::TestBuilder::tool) [list source [file join $dir testbuilder.tcl]]
    66 set auto_index(::Rappture::Tester::TestBuilder::constructor) [list source [file join $dir testbuilder.tcl]]
    67 set auto_index(::Rappture::Tester::selectionHandler) [list source [file join $dir tester.tcl]]
    68 set auto_index(::Rappture::Tester::regoldenize) [list source [file join $dir tester.tcl]]
    69 set auto_index(::Rappture::Tester::makeTest) [list source [file join $dir tester.tcl]]
     23set auto_index(::Rappture::Tester::Test) [list source [file join $dir test.tcl]]
     24set auto_index(::Rappture::Tester::Test::constructor) [list source [file join $dir test.tcl]]
     25set auto_index(::Rappture::Tester::Test::destructor) [list source [file join $dir test.tcl]]
     26set auto_index(::Rappture::Tester::Test::getResult) [list source [file join $dir test.tcl]]
     27set auto_index(::Rappture::Tester::Test::getTestInfo) [list source [file join $dir test.tcl]]
     28set auto_index(::Rappture::Tester::Test::run) [list source [file join $dir test.tcl]]
     29set auto_index(::Rappture::Tester::Test::regoldenize) [list source [file join $dir test.tcl]]
     30set auto_index(::Rappture::Tester::Test::getAdded) [list source [file join $dir test.tcl]]
     31set auto_index(::Rappture::Tester::Test::getDiffs) [list source [file join $dir test.tcl]]
     32set auto_index(::Rappture::Tester::Test::getInputs) [list source [file join $dir test.tcl]]
     33set auto_index(::Rappture::Tester::Test::getMissing) [list source [file join $dir test.tcl]]
     34set auto_index(::Rappture::Tester::Test::getOutputs) [list source [file join $dir test.tcl]]
     35set auto_index(::Rappture::Tester::Test::getRunobj) [list source [file join $dir test.tcl]]
     36set auto_index(::Rappture::Tester::Test::getTestobj) [list source [file join $dir test.tcl]]
     37set auto_index(::Rappture::Tester::Test::added) [list source [file join $dir test.tcl]]
     38set auto_index(::Rappture::Tester::Test::compareElements) [list source [file join $dir test.tcl]]
     39set auto_index(::Rappture::Tester::Test::diffs) [list source [file join $dir test.tcl]]
     40set auto_index(::Rappture::Tester::Test::merge) [list source [file join $dir test.tcl]]
     41set auto_index(::Rappture::Tester::Test::missing) [list source [file join $dir test.tcl]]
     42set auto_index(::Rappture::Tester::Test::_setResult) [list source [file join $dir test.tcl]]
     43set auto_index(::Rappture::Tester::TestView) [list source [file join $dir testview.tcl]]
     44set auto_index(::Rappture::Tester::TestView::constructor) [list source [file join $dir testview.tcl]]
     45set auto_index(::Rappture::Tester::TestView::show) [list source [file join $dir testview.tcl]]
     46set auto_index(::Rappture::Tester::TestView::_doRun) [list source [file join $dir testview.tcl]]
     47set auto_index(::Rappture::Tester::TestView::_plural) [list source [file join $dir testview.tcl]]
    7048set auto_index(::Rappture::Tester::TestTree) [list source [file join $dir testtree.tcl]]
     49set auto_index(::Rappture::Tester::TestTree::spinner) [list source [file join $dir testtree.tcl]]
    7150set auto_index(::Rappture::Tester::TestTree::constructor) [list source [file join $dir testtree.tcl]]
    7251set auto_index(::Rappture::Tester::TestTree::destructor) [list source [file join $dir testtree.tcl]]
    73 set auto_index(::Rappture::Tester::TestTree::testdir) [list source [file join $dir testtree.tcl]]
    74 set auto_index(::Rappture::Tester::TestTree::toolxml) [list source [file join $dir testtree.tcl]]
    75 set auto_index(::Rappture::Tester::TestTree::selectcommand) [list source [file join $dir testtree.tcl]]
    76 set auto_index(::Rappture::Tester::TestTree::getTest) [list source [file join $dir testtree.tcl]]
    77 set auto_index(::Rappture::Tester::TestTree::refresh) [list source [file join $dir testtree.tcl]]
    78 set auto_index(::Rappture::Tester::TestTree::getData) [list source [file join $dir testtree.tcl]]
    79 set auto_index(::Rappture::Tester::TestTree::getLeaves) [list source [file join $dir testtree.tcl]]
    80 set auto_index(::Rappture::Tester::TestTree::getSelected) [list source [file join $dir testtree.tcl]]
    81 set auto_index(::Rappture::Tester::TestTree::populate) [list source [file join $dir testtree.tcl]]
    82 set auto_index(::Rappture::Tester::TestTree::runSelected) [list source [file join $dir testtree.tcl]]
    83 set auto_index(::Rappture::Tester::TestTree::runTest) [list source [file join $dir testtree.tcl]]
    84 set auto_index(::Rappture::Tester::TestTree::setData) [list source [file join $dir testtree.tcl]]
    85 set auto_index(::Rappture::Tester::TestTree::updateLabel) [list source [file join $dir testtree.tcl]]
    86 set auto_index(::Rappture::Tester::TestView) [list source [file join $dir testview.tcl]]
    87 set auto_index(::Rappture::Tester::TestView::constructor) [list source [file join $dir testview.tcl]]
    88 set auto_index(::Rappture::Tester::TestView::test) [list source [file join $dir testview.tcl]]
    89 set auto_index(::Rappture::Tester::TestView::reset) [list source [file join $dir testview.tcl]]
    90 set auto_index(::Rappture::Tester::TestView::showDescription) [list source [file join $dir testview.tcl]]
    91 set auto_index(::Rappture::Tester::TestView::showStatus) [list source [file join $dir testview.tcl]]
    92 set auto_index(::Rappture::Tester::TestView::updateResults) [list source [file join $dir testview.tcl]]
    93 set auto_index(::Rappture::Tester::TestView::updateInputs) [list source [file join $dir testview.tcl]]
    94 set auto_index(::Rappture::Tester::TestView::updateOutputs) [list source [file join $dir testview.tcl]]
     52set auto_index(::Rappture::Tester::TestTree::add) [list source [file join $dir testtree.tcl]]
     53set auto_index(::Rappture::Tester::TestTree::clear) [list source [file join $dir testtree.tcl]]
     54set auto_index(::Rappture::Tester::TestTree::curselection) [list source [file join $dir testtree.tcl]]
     55set auto_index(::Rappture::Tester::TestTree::_getTest) [list source [file join $dir testtree.tcl]]
     56set auto_index(::Rappture::Tester::TestTree::_refresh) [list source [file join $dir testtree.tcl]]
     57set auto_index(::Rappture::Tester::TestTree::_getLeaves) [list source [file join $dir testtree.tcl]]
     58set auto_index(::Rappture::Tester::TestTree::spinner) [list source [file join $dir testtree.tcl]]
     59set auto_index(::Rappture::Tester::StatusEntry) [list source [file join $dir statuslist.tcl]]
     60set auto_index(::Rappture::Tester::StatusList) [list source [file join $dir statuslist.tcl]]
     61set auto_index(::Rappture::Tester::StatusList::constructor) [list source [file join $dir statuslist.tcl]]
     62set auto_index(::Rappture::Tester::StatusList::destructor) [list source [file join $dir statuslist.tcl]]
     63set auto_index(::Rappture::Tester::StatusList::insert) [list source [file join $dir statuslist.tcl]]
     64set auto_index(::Rappture::Tester::StatusList::delete) [list source [file join $dir statuslist.tcl]]
     65set auto_index(::Rappture::Tester::StatusList::_redraw) [list source [file join $dir statuslist.tcl]]
     66set auto_index(::Rappture::Tester::StatusList::_select) [list source [file join $dir statuslist.tcl]]
     67set auto_index(tester_selection_changed) [list source [file join $dir tester.tcl]]
     68set auto_index(tester_run) [list source [file join $dir tester.tcl]]
     69set auto_index(tester_run_next) [list source [file join $dir tester.tcl]]
     70set auto_index(tester_run_output) [list source [file join $dir tester.tcl]]
     71set auto_index(tester_diff_show) [list source [file join $dir tester.tcl]]
     72set auto_index(tester_regoldenize) [list source [file join $dir tester.tcl]]

  • trunk/tester/test.tcl

    r2074 r2077  
    1414# ======================================================================
    1515
    16 namespace eval Rappture::Tester::Test { #forward declaration }
     16namespace eval Rappture::Tester { #forward declaration }
    1717
    1818itcl::class Rappture::Tester::Test {
    19 
    20     constructor {toolxml testxml} { #defined later }
     19    public variable notifycommand ""
     20
     21    constructor {tool testxml args} { #defined later }
    2122    destructor { #defined later }
     23
     24    public method getResult {}
     25    public method getTestInfo {path}
     26
     27    public method run {args}
     28    public method regoldenize {}
     29
     30    private variable _toolobj ""  ;# Rappture::Tool for tool being tested
     31    private variable _testxml ""  ;# XML file for test case
     32    private variable _testobj ""  ;# Rappture::Library object for _testxml
    2233
    2334    private variable _added ""
    2435    private variable _diffs ""
    2536    private variable _missing ""
    26     private variable _ran no
    27     private variable _testxml
    28     private variable _toolxml
    29     private variable _result ""
    30     private variable _runfile ""
    31     private variable _testobj ""
    32     private variable _toolobj ""
     37    private variable _result "?"
    3338    private variable _runobj ""
    3439
     40    # don't need this?
    3541    public method getAdded {}
    3642    public method getDiffs {}
    … …  
    3844    public method getMissing {}
    3945    public method getOutputs {{path output}}
    40     public method getResult {}
    41     public method getRunfile {}
    4246    public method getRunobj {}
    4347    public method getTestobj {}
    44     public method getTestxml {}
    45     public method hasRan {}
    46     public method regoldenize {}
    47     public method run {}
    48 
     48
     49    private method _setResult {name}
    4950    private method added {lib1 lib2 {path output}}
    5051    private method compareElements {lib1 lib2 path}
    5152    private method diffs {lib1 lib2 {path output}}
    52     private method makeDriver {}
    5353    private method merge {toolobj golden driver {path input}}
    5454    private method missing {lib1 lib2 {path output}}
    55 
    5655}
    5756
    … …  
    5958# CONSTRUCTOR
    6059# ----------------------------------------------------------------------
    61 itcl::body Rappture::Tester::Test::constructor {toolxml testxml} {
    62     set _toolxml $toolxml
     60itcl::body Rappture::Tester::Test::constructor {toolobj testxml args} {
     61    set _toolobj $toolobj
     62
    6363    set _testxml $testxml
    64     set _toolobj [Rappture::library $toolxml]
    65     if {![Rappture::library isvalid $_toolobj]} {
    66         error "$toolxml does not represent a valid library object"
    67     }
    6864    set _testobj [Rappture::library $testxml]
    69     if {![Rappture::library isvalid $_testobj]} {
    70         error "$testxml does not represent a valid library object"
    71     }
     65
    7266    # HACK: Add a new input to differentiate between results
    7367    $_testobj put input.TestRun.current "Golden"
     68
     69    eval configure $args
    7470}
    7571
    … …  
    8076    itcl::delete object $_toolobj
    8177    itcl::delete object $_testobj
    82     if {$_ran && $_testobj != $_runobj} {
     78    if {$_runobj ne ""} {
    8379        itcl::delete object $_runobj
    8480    }
     81}
     82
     83# ----------------------------------------------------------------------
     84# USAGE: getResult
     85#
     86# Returns the result of the test:
     87#   ? ...... test hasn't been run yet
     88#   Pass ... test ran recently and passed
     89#   Fail ... test ran recently and failed
     90#   Error ... test ran recently and run failed with an error
     91# ----------------------------------------------------------------------
     92itcl::body Rappture::Tester::Test::getResult {} {
     93    return $_result
     94}
     95
     96# ----------------------------------------------------------------------
     97# USAGE: getTestInfo <path>
     98#
     99# Returns info about the Test case at the specified <path> in the XML.
     100# If the <path> is missing or misspelled, this method returns ""
     101# instead of an error.
     102# ----------------------------------------------------------------------
     103itcl::body Rappture::Tester::Test::getTestInfo {path} {
     104    return [$_testobj get $path]
     105}
     106
     107# ----------------------------------------------------------------------
     108# USAGE: run ?-output callback path value path value ...?
     109#
     110# Kicks off a new simulation and checks the results against the golden
     111# set of results.  Any arguments passed in are passed along to the
     112# Tool object managing the run.  This may include parameter override
     113# values and a callback for partial output.
     114# ----------------------------------------------------------------------
     115itcl::body Rappture::Tester::Test::run {args} {
     116    # Delete existing library if rerun
     117    if {$_runobj ne ""} {
     118        itcl::delete object $_runobj
     119        set _runobj ""
     120    }
     121
     122    # copy inputs from the test into the run file
     123    foreach path [Rappture::entities -as path $_testobj input] {
     124        if {[$_testobj element -as type $path.current] ne ""} {
     125puts "  override: $path = [$_testobj get $path.current]"
     126            lappend args $path [$_testobj get $path.current]
     127        }
     128    }
     129
     130    # run the test case...
     131    _setResult "Running"
     132    foreach {status _runobj} [eval $_toolobj run $args] break
     133
     134    if {$status == 0 && [Rappture::library isvalid $_runobj]} {
     135        # HACK: Add a new input to differentiate between results
     136        $_runobj put input.TestRun.current "Test result"
     137        set _diffs [diffs $_testobj $_runobj]
     138        set _missing [missing $_testobj $_runobj]
     139        set _added [added $_testobj $_runobj]
     140        if {$_diffs == "" && $_missing == "" && $_added == ""} {
     141            _setResult "Pass"
     142        } else {
     143            _setResult "Fail"
     144        }
     145    } else {
     146        set _runobj ""
     147        set _setResult "Error"
     148    }
     149}
     150
     151# ----------------------------------------------------------------------
     152# USAGE: regoldenize
     153#
     154# Regoldenize the test by overwriting the test xml containin the golden
     155# results with the data in the runfile generated by the last run.  Copy
     156# test label and description into the new file.  Update the test's
     157# result attributes to reflect the changes. Throws an error if the test
     158# has not been run.
     159# ----------------------------------------------------------------------
     160itcl::body Rappture::Tester::Test::regoldenize {} {
     161    if {$_runobj eq ""} {
     162        error "Test has not yet been run."
     163    }
     164    $_runobj put test.label [$_testobj get test.label]
     165    $_runobj put test.description [$_testobj get test.description]
     166    set fid [open $_testxml w]
     167    puts $fid "<?xml version=\"1.0\"?>"
     168    puts $fid [$_runobj xml]
     169    close $fid
     170    set _testobj $_runobj
     171    set _diffs ""
     172    set _added ""
     173    set _missing ""
     174    _setResult Pass
    85175}
    86176
    … …  
    92182# ----------------------------------------------------------------------
    93183itcl::body Rappture::Tester::Test::getAdded {} {
    94     if {!$_ran} {
    95         error "Test has not yet been ran."
     184    if {$_runobj eq ""} {
     185        error "Test has not yet been run."
    96186    }
    97187    return $_added
    … …  
    103193# Returns a list of paths that exist in both the golden and new results,
    104194# but contain data that does not match according to the compareElements
    105 # method.  Throws an error if the test has not been ran.
     195# method.  Throws an error if the test has not been run.
    106196# ----------------------------------------------------------------------
    107197itcl::body Rappture::Tester::Test::getDiffs {} {
    108     if {!$_ran} {
    109         error "Test has not yet been ran."
    110     }
    111     return $_diffs
     198    return [list \
     199        input.number(temperature) label \
     200        output.curve(f12) units \
     201        output.curve(f12) result]
    112202}
    113203
    … …  
    126216            set val [$_testobj get $fullpath.current]
    127217            if {$val != ""} {
    128                 lappend retval [list $fullpath $val]
     218                lappend retval $fullpath $val
    129219            }
    130220        }
    131         append retval " [getInputs $fullpath]"
     221        append retval [getInputs $fullpath]
    132222    }
    133223    return $retval
    … …  
    142232# ----------------------------------------------------------------------
    143233itcl::body Rappture::Tester::Test::getMissing {} {
    144     if {!$_ran} {
    145         error "Test has not yet been ran."
     234    if {$_runobj eq ""} {
     235        error "Test has not yet been run."
    146236    }
    147237    return $_missing
    … …  
    154244# generated by the last run of the test.  Each key is the path to the
    155245# element, and each value is its status (ok, diff, added, or missing).
    156 # Throws an error if the test has not been ran.
     246# Throws an error if the test has not been run.
    157247# ----------------------------------------------------------------------
    158248itcl::body Rappture::Tester::Test::getOutputs {{path output}} {
    159     if {!$_ran} {
    160         error "Test has not yet been ran."
     249    if {$_runobj eq ""} {
     250        error "Test has not yet been run."
    161251    }
    162252    set retval [list]
    … …  
    176266                }
    177267            }
    178             lappend retval [list $fullpath $status]
     268            lappend retval $fullpath $status
    179269        }
    180270        append retval " [getOutputs $fullpath]"
    … …  
    190280}
    191281
    192 # ----------------------------------------------------------------------
    193 # USAGE: getResult
    194 #
    195 # Returns the result of the test - either Pass, Fail, or Error.  Returns
    196 # an empty string if the test has not been ran.
    197 # ----------------------------------------------------------------------
    198 itcl::body Rappture::Tester::Test::getResult {} {
    199     return $_result
    200 }
    201 
    202 # ----------------------------------------------------------------------
    203 # USAGE: getRunfile
    204 #
    205 # Returns the location of the runfile generated by the previous run of
    206 # the test.  Throws an error if the test has not been ran.
    207 # ----------------------------------------------------------------------
    208 itcl::body Rappture::Tester::Test::getRunfile {} {
    209     if {!$_ran} {
    210         error "Test has not yet been ran."
    211     }
    212     return $_runfile
    213 }
    214 
    215282# -----------------------------------------------------------------------
    216283# USAGE: getRunobj
    217284#
    218285# Returns the library object generated by the previous run of the test.
    219 # Throws an error if the test has not been ran.
     286# Throws an error if the test has not been run.
    220287# -----------------------------------------------------------------------
    221288itcl::body Rappture::Tester::Test::getRunobj {} {
    222     if {!$_ran} {
    223         error "Test has not yet been ran."
     289    if {$_runobj eq ""} {
     290        error "Test has not yet been run."
    224291    }
    225292    return $_runobj
    226 }
    227 
    228 # ----------------------------------------------------------------------
    229 # USAGE: getTestxml
    230 #
    231 # Returns the location of the test xml file containing the set of golden
    232 # results.
    233 # ----------------------------------------------------------------------
    234 itcl::body Rappture::Tester::Test::getTestxml {} {
    235     return $_testxml
    236293}
    237294
    … …  
    243300itcl::body Rappture::Tester::Test::getTestobj {} {
    244301    return $_testobj
    245 }
    246 
    247 # ----------------------------------------------------------------------
    248 # USAGE: hasRan
    249 #
    250 # Returns yes if the test has been ran (with the run method), returns
    251 # no otherwise.
    252 # ----------------------------------------------------------------------
    253 itcl::body Rappture::Tester::Test::hasRan {} {
    254     return $_ran
    255 }
    256 
    257 # ----------------------------------------------------------------------
    258 # USAGE: regoldenize
    259 #
    260 # Regoldenize the test by overwriting the test xml containin the golden
    261 # results with the data in the runfile generated by the last run.  Copy
    262 # test label and description into the new file.  Update the test's
    263 # result attributes to reflect the changes. Throws an error if the test
    264 # has not been ran.
    265 # ----------------------------------------------------------------------
    266 itcl::body Rappture::Tester::Test::regoldenize {} {
    267     if {!$_ran} {
    268         error "Test has not yet been ran."
    269     }
    270     $_runobj put test.label [$_testobj get test.label]
    271     $_runobj put test.description [$_testobj get test.description]
    272     set fid [open $_testxml w]
    273     puts $fid "<?xml version=\"1.0\"?>"
    274     puts $fid [$_runobj xml]
    275     close $fid
    276     set _testobj $_runobj
    277     set _result Pass
    278     set _diffs ""
    279     set _added ""
    280     set _missing ""
    281 }
    282 
    283 
    284 # ----------------------------------------------------------------------
    285 # USAGE: run
    286 #
    287 # Kicks off a new simulation and checks the results against the golden
    288 # set of results.  Set private attributes accordingly so that they can
    289 # later be retrieved via the public accessors.
    290 # ----------------------------------------------------------------------
    291 itcl::body Rappture::Tester::Test::run {} {
    292     # Delete existing library if rerun
    293     if {$_ran && $_result != "Error"} {
    294         itcl::delete object $_runobj
    295     }
    296     set driver [makeDriver]
    297     set tool [Rappture::Tool ::#auto $driver [file dirname $_toolxml]]
    298     foreach {status _runobj} [eval $tool run] break
    299     set _ran yes
    300     if {$status == 0 && [Rappture::library isvalid $_runobj]} {
    301         # HACK: Add a new input to differentiate between results
    302         $_runobj put input.TestRun.current "Test result"
    303         set _diffs [diffs $_testobj $_runobj]
    304         set _missing [missing $_testobj $_runobj]
    305         set _added [added $_testobj $_runobj]
    306         set _runfile [$tool getRunFile]
    307         if {$_diffs == "" && $_missing == "" && $_added == ""} {
    308             set _result Pass
    309         } else {
    310             set _result Fail
    311         }
    312     } else {
    313         set _runobj ""
    314         set _result Error
    315     }
    316302}
    317303
    … …  
    383369
    384370# ----------------------------------------------------------------------
    385 # USAGE: makeDriver
    386 #
    387 # Builds and returns a driver library object to be used for running the
    388 # test specified by testxml.  Copy current values from test xml into the
    389 # newly created driver.  If any inputs are present in the new tool.xml
    390 # which do not exist in the test xml, use the default value.
    391 # ----------------------------------------------------------------------
    392 itcl::body Rappture::Tester::Test::makeDriver {} {
    393     set driver [Rappture::library $_toolxml]
    394     return [merge $_toolobj $_testobj $driver]
    395 }
    396 
    397 # ----------------------------------------------------------------------
    398371# USAGE: merge <toolobj> <golden> <driver> ?path?
    399372#
    … …  
    438411    return $paths
    439412}
     413
     414# ----------------------------------------------------------------------
     415# USAGE: _setResult ?|Pass|Fail|Waiting|Running
     416#
     417# Used internally to change the state of this test case.  If there
     418# is a -notifycommand script for this object, it is invoked to notify
     419# an interested client that the object has changed.
     420# ----------------------------------------------------------------------
     421itcl::body Rappture::Tester::Test::_setResult {name} {
     422puts "CHANGED: $this => $name"
     423    set _result $name
     424    if {[string length $notifycommand] > 0} {
     425puts "  notified $notifycommand"
     426        uplevel #0 $notifycommand $this
     427    }
     428}

  • trunk/tester/tester.tcl

    r2074 r2077  
    2828# wish executes everything from here on...
    2929
    30 # TODO: Won't need this once tied in with the rest of the package
    31 lappend auto_path [file dirname $argv0]
     30set testerdir [file dirname [file normalize [info script]]]
     31lappend auto_path $testerdir
    3232
    3333package require Itk
     34package require Img
    3435package require Rappture
    3536package require RapptureGUI
     37
     38option add *selectBackground #bfefff
     39option add *Tooltip.background white
     40option add *Editor.background white
     41option add *Gauge.textBackground white
     42option add *TemperatureGauge.textBackground white
     43option add *Switch.textBackground white
     44option add *Progress.barColor #ffffcc
     45option add *Balloon.titleBackground #6666cc
     46option add *Balloon.titleForeground white
     47option add *Balloon*Label.font -*-helvetica-medium-r-normal-*-12-*
     48option add *Balloon*Radiobutton.font -*-helvetica-medium-r-normal-*-12-*
     49option add *Balloon*Checkbutton.font -*-helvetica-medium-r-normal-*-12-*
     50option add *ResultSet.controlbarBackground #6666cc
     51option add *ResultSet.controlbarForeground white
     52option add *ResultSet.activeControlBackground #ccccff
     53option add *ResultSet.activeControlForeground black
     54option add *Radiodial.length 3i
     55option add *BugReport*banner*foreground white
     56option add *BugReport*banner*background #a9a9a9
     57option add *BugReport*banner*highlightBackground #a9a9a9
     58option add *BugReport*banner*font -*-helvetica-bold-r-normal-*-18-*
     59
     60switch $tcl_platform(platform) {
     61    unix - windows {
     62        event add <<PopupMenu>> <ButtonPress-3>
     63    }
     64    macintosh {
     65        event add <<PopupMenu>> <Control-ButtonPress-1>
     66    }
     67}
     68
     69# install a better bug handler
     70Rappture::bugreport::install
     71
     72# fix the "grab" command to support a stack of grab windows
     73Rappture::grab::init
     74
     75# add the local image directory onto the path
     76Rappture::icon foo  ;# forces auto-loading of Rappture::icon
     77set Rappture::icon::iconpath [linsert $Rappture::icon::iconpath 0 [file join $testerdir images]]
     78
     79# current list of running tests
     80set RunQueue ""
     81
    3682
    3783Rappture::getopts argv params {
    … …  
    65111        exit 1
    66112    }
    67 # If given test directory does not exist, create it.
    68 } elseif {![file exists $params(-testdir)]} {
    69     file mkdir $params(-testdir)
    70 } else {
    71     puts "Non-directory file exists at test location \"$params(-testdir)\""
     113} elseif {![file isdirectory $params(-testdir)]} {
     114    puts "Test directory \"$params(-testdir)\" does not exist"
    72115    exit 1
    73116}
    74117
     118set installdir [file dirname [file normalize $params(-tool)]]
     119set xmlobj [Rappture::library $params(-tool)]
     120set ToolObj [Rappture::Tool ::#auto $xmlobj $installdir]
     121
    75122# ----------------------------------------------------------------------
    76123# INITIALIZE WINDOW
    77124# ----------------------------------------------------------------------
    78125wm title . "Rappture Regression Tester"
    79 
    80 menu .mb
    81 menu .mb.file -tearoff 0
    82 .mb add cascade -label "File" -underline 0 -menu .mb.file
    83 .mb.file add command -label "Select tool" -underline 7 \
    84     -command {set params(-tool) [tk_getOpenFile]
    85               .tree configure -toolxml $params(-tool)}
    86 .mb.file add command -label "Select test directory" -underline 12 \
    87     -command {set params(-testdir) [tk_chooseDirectory]
    88               .tree configure -testdir $params(-testdir)}
    89 .mb.file add command -label "Exit" -underline 1 -command {destroy .}
    90 . configure -menu .mb
    91 
    92 panedwindow .pw
    93 
    94 .pw add [Rappture::Tester::TestTree .tree \
    95     -testdir $params(-testdir) \
    96     -toolxml $params(-tool) \
    97     -selectcommand Rappture::Tester::selectionHandler]
    98 
    99 .pw add [frame .right]
    100 Rappture::Tester::TestView .right.view
    101 button .right.regoldenize -text "Regoldenize" -state disabled \
    102     -command Rappture::Tester::regoldenize
    103 pack .right.regoldenize -side bottom -anchor e
    104 pack .right.view -side bottom -expand yes -fill both
    105 
     126wm geometry . 800x500
     127Rappture::Panes .pw -orientation horizontal -sashcursor sb_h_double_arrow
    106128pack .pw -expand yes -fill both
    107129
    108 set lastsel ""
    109 
    110 # TODO: Handle resizing better
    111 
    112 # ----------------------------------------------------------------------
    113 # USAGE: selectionHandler ?-refresh?
    114 #
    115 # Used internally to communicate between the test tree and the right
    116 # hand side viewer.  Upon selecting a new tree node, pass the focused
    117 # node's data to the right hand side.  Use the -refresh option to force
    118 # the selected test to be re-displayed on the right side.
    119 # ----------------------------------------------------------------------
    120 proc Rappture::Tester::selectionHandler {args} {
    121     global lastsel
    122     set test [.tree getTest]
    123     if {$test != $lastsel || [lsearch $args "-refresh"] != -1} {
    124         .right.view configure -test $test
    125         if {$test != "" && [$test hasRan] && [$test getResult] != "Error"} {
    126             .right.regoldenize configure -state normal
     130set win [.pw pane 0]
     131Rappture::Tester::TestTree $win.tree \
     132    -selectcommand tester_selection_changed
     133pack $win.tree -expand yes -fill both -padx 8 -pady 8
     134
     135set win [.pw insert end -fraction 0.8]
     136
     137# Frame for viewing tests
     138# ----------------------------------------------------------------------
     139frame $win.testview
     140button $win.testview.regoldenize -text "<< New golden standard" \
     141    -state disabled -command tester_regoldenize
     142pack $win.testview.regoldenize -side bottom -anchor w
     143Rappture::Tooltip::for $win.testview.regoldenize \
     144    "If this test result differs from the established test case, you would normally fix your tool to produce the correct result.  In some cases, however, your updated tool may be producing different, but correct, results.  In those cases, you can press this button to update the test itself to use the current output as the new golden standard for this test case."
     145
     146Rappture::Tester::TestView $win.testview.overview \
     147    -runcommand tester_run
     148pack $win.testview.overview -side top -fill both -padx 8 -pady 8
     149
     150frame $win.testview.details
     151label $win.testview.details.heading -text "Differences:"
     152pack $win.testview.details.heading -side top -anchor w
     153Rappture::Scroller $win.testview.details.scrl \
     154    -xscrollmode auto -yscrollmode auto
     155pack $win.testview.details.scrl -expand yes -fill both
     156Rappture::Tester::StatusList $win.testview.details.scrl.list \
     157    -selectcommand tester_diff_show
     158$win.testview.details.scrl contents $win.testview.details.scrl.list
     159
     160# Frame for viewing running tests
     161# ----------------------------------------------------------------------
     162frame $win.testrun
     163button $win.testrun.abort -text "Abort"
     164pack $win.testrun.abort -side bottom
     165
     166Rappture::Scroller $win.testrun.scrl -xscrollmode auto -yscrollmode auto
     167pack $win.testrun.scrl -expand yes -fill both
     168text $win.testrun.scrl.info -width 1 -height 1 -wrap none
     169$win.testrun.scrl contents $win.testrun.scrl.info
     170
     171# Load all tests in the test directory
     172# ----------------------------------------------------------------------
     173set testtree [.pw pane 0].tree
     174foreach file [glob -nocomplain -directory $params(-testdir) *.xml] {
     175    set testobj [Rappture::Tester::Test ::#auto $ToolObj $file]
     176    $testtree add $testobj
     177}
     178$testtree component treeview open -recurse root
     179
     180# ----------------------------------------------------------------------
     181# USAGE: tester_selection_changed
     182#
     183# Invoked automatically whenever the selection changes in the tree
     184# on the left.  Brings up a description of one or more selected tests
     185# on the right-hand side.
     186# ----------------------------------------------------------------------
     187proc tester_selection_changed {args} {
     188    set testtree [.pw pane 0].tree
     189    set rhs [.pw pane 1]
     190    set testview $rhs.testview
     191    set tests [$testtree curselection]
     192
     193    # figure out what we should be showing on the right-hand side
     194    if {[llength $tests] > 0} {
     195        set status "?"
     196        foreach obj $tests {
     197            if {[$obj getResult] == "Running"} {
     198                set status "Running"
     199            }
     200        }
     201        if {$status == "Running"} {
     202            set detailwidget $rhs.testrun
    127203        } else {
    128             .right.regoldenize configure -state disabled
    129         }
    130         set lastsel $test
    131     }
    132 }
    133 
    134 # ----------------------------------------------------------------------
    135 # USAGE: regoldenize
     204            set detailwidget $rhs.testview
     205        }
     206    } else {
     207        set detailwidget ""
     208    }
     209
     210    # repack the right-hand side, if necessary
     211    if {$detailwidget ne [pack slaves $rhs]} {
     212        foreach win [pack slaves $rhs] {
     213            pack forget $win
     214        }
     215        pack $detailwidget -expand yes -fill both
     216    }
     217
     218    if {[llength $tests] > 0} {
     219        eval $testview.overview show $tests
     220        pack $testview -expand yes -fill both -padx 8 -pady 8
     221        if {[llength $tests] == 1 && [$tests getResult] eq "Fail"} {
     222            pack $testview.regoldenize -side bottom -anchor w
     223            $testview.regoldenize configure -state normal
     224
     225            # build up a detailed list of diffs for this one test
     226            pack $testview.details -side bottom -expand yes -fill both
     227
     228            set testobj [lindex $tests 0]
     229            $testview.details.scrl.list delete 0 end
     230            foreach {path info} [$testobj getDiffs] {
     231                set title [$testobj getTestInfo $path.about.label]
     232                if {[string match output.* $path]} {
     233                    set title "Output: $title"
     234                }
     235                switch -- [lindex $info 0] {
     236                    result {
     237                        set desc "Result differs from expected value"
     238                        set icon [Rappture::icon fail16]
     239                    }
     240                    default {
     241                        set desc $info
     242                        set icon [Rappture::icon warn16]
     243                    }
     244                }
     245
     246                # add to the list of differences
     247                $testview.details.scrl.list insert end \
     248                    -title $title -subtitle $path -body $desc \
     249                    -icon $icon -clientdata $testobj
     250            }
     251
     252        } else {
     253            $testview.regoldenize configure -state disabled
     254            pack forget $testview.details $testview.regoldenize
     255        }
     256    }
     257}
     258
     259# ----------------------------------------------------------------------
     260# USAGE: tester_run <testObj> <testObj> ...
     261#
     262# Invoked whenever the user presses the "Run" button for one or more
     263# selected tests.  Puts the tool into "run" mode and starts running
     264# the various test cases.
     265# ----------------------------------------------------------------------
     266proc tester_run {args} {
     267    global RunQueue
     268    set testtree [.pw pane 0].tree
     269
     270    # add these tests to the run queue
     271    foreach obj $args {
     272        if {[lsearch $RunQueue $obj] < 0} {
     273            lappend RunQueue $obj
     274        }
     275    }
     276
     277    after idle tester_run_next
     278}
     279
     280# ----------------------------------------------------------------------
     281# USAGE: tester_run_next
     282#
     283# Takes the next test from the queue and runs it.  Displays any
     284# output during the run, then compares results and shows a final
     285# pass/fail status.
     286# ----------------------------------------------------------------------
     287proc tester_run_next {} {
     288    global RunQueue
     289
     290    set obj [lindex $RunQueue 0]
     291    set RunQueue [lrange $RunQueue 1 end]
     292
     293    if {$obj ne ""} {
     294puts "RUNNING: $obj"
     295        set testrun [.pw pane 1].testrun
     296        $testrun.abort configure -command [list $obj abort]
     297        $obj run -output tester_run_output
     298    }
     299
     300    # keep running remaining tests
     301    after idle tester_run_next
     302}
     303
     304# ----------------------------------------------------------------------
     305# USAGE: tester_run_output <string>
     306#
     307# Adds the <string> output from running a test case into the viewer
     308# for that test.
     309# ----------------------------------------------------------------------
     310proc tester_run_output {string} {
     311    set testrun [.pw pane 1].testrun
     312    $testrun.scrl.info configure -state normal
     313    $testrun.scrl.info insert end $string
     314
     315    # if there are too many lines, delete some
     316    set lines [lindex [split [$testrun.scrl.info index end-2char] .] 0]
     317    if {$lines > 500} {
     318        set extra [expr {$lines-500+1}]
     319        $testrun.scrl.info delete 1.0 $extra.0
     320    }
     321
     322    # show the newest stuff
     323    $testrun.scrl.info see end
     324    $testrun.scrl.info configure -state disabled
     325}
     326
     327# ----------------------------------------------------------------------
     328# USAGE: tester_diff_show -option value -option value ...
     329#
     330# Pops up a panel showing more detailed information about a particular
     331# difference found in a particular test case.
     332# ----------------------------------------------------------------------
     333proc tester_diff_show {args} {
     334    puts "SHOW DETAIL: $args"
     335}
     336
     337# ----------------------------------------------------------------------
     338# USAGE: tester_regoldenize
    136339#
    137340# Regoldenizes the currently focused test case.  Displays a warning
    … …  
    140343# xml.
    141344# ----------------------------------------------------------------------
    142 proc Rappture::Tester::regoldenize {} {
    143     set test [.tree getTest]
     345proc tester_regoldenize {} {
     346    set testtree [.pw pane 0].tree
     347
     348    set test [$testtree getTest]
    144349    set testxml [$test getTestxml]
    145350    if {[tk_messageBox -type yesno -icon warning -message "Are you sure you want to regoldenize?\n$testxml will be overwritten."]} {
    146351        $test regoldenize
    147         .tree refresh
    148         selectionHandler -refresh
    149     }
    150 }
    151 
     352
     353        # reload the updated description for this test
     354        tester_selection_changed
     355    }
     356}

  • trunk/tester/testtree.tcl

    r2068 r2077  
    3333    inherit itk::Widget
    3434
    35     itk_option define -selectcommand selectCommand SelectCommand ""
    36     itk_option define -testdir testDir TestDir ""
    37     itk_option define -toolxml toolXml ToolXml ""
    38 
    3935    constructor {args} { #defined later }
    4036    destructor { #defined later }
    4137
    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 
     38    public method add {args}
     39    public method clear {}
     40    public method curselection {}
     41
     42    protected method _getLeaves {{id 0}}
     43    protected method _getTest {id}
     44    protected method _refresh {args}
     45
     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)]]
    5459}
    5560 
    … …  
    6671            -xscrollmode auto -yscrollmode auto
    6772    }
     73    pack $itk_component(scrollbars) -expand yes -fill both
     74
    6875    itk_component add treeview {
    6976        blt::treeview $itk_component(scrollbars).treeview -separator | \
    70             -autocreate true -selectmode multiple
     77            -autocreate true -selectmode multiple \
     78            -icons [list [Rappture::icon folder] [Rappture::icon folder2]] \
     79            -activeicons ""
    7180    } {
    7281        keep -foreground -font -cursor
    73     }
    74     $itk_component(treeview) column insert 0 result -width 75
     82        keep -selectcommand
     83    }
     84    $itk_component(treeview) column insert 0 result -title "Result"
    7585    $itk_component(treeview) column insert end test -hide yes
     86    $itk_component(treeview) column configure treeView -justify left -title "Test Case"
    7687    $itk_component(scrollbars) contents $itk_component(treeview)
    7788
    … …  
    7990        frame $itk_interior.bottomBar
    8091    }
    81     pack $itk_component(bottomBar) -fill x -side bottom
     92    pack $itk_component(bottomBar) -fill x -side bottom -pady {8 0}
     93
     94    itk_component add selLabel {
     95        label $itk_component(bottomBar).selLabel -anchor w -text "Select:"
     96    }
     97    pack $itk_component(selLabel) -side left
    8298
    8399    itk_component add bSelectAll {
    84         button $itk_component(bottomBar).bSelectAll -text "Select all" \
     100        button $itk_component(bottomBar).bSelectAll -text "All" \
    85101            -command "$itk_component(treeview) selection set 0 end"
    86102    }
    … …  
    88104
    89105    itk_component add bSelectNone {
    90         button $itk_component(bottomBar).bSelectNone -text "Select none" \
     106        button $itk_component(bottomBar).bSelectNone -text "None" \
    91107            -command "$itk_component(treeview) selection clearall"
    92108    }
    93109    pack $itk_component(bSelectNone) -side left
    94110
    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
    109111
    110112    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 
    119113}
    120114
    … …  
    123117# ----------------------------------------------------------------------
    124118itcl::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 # ----------------------------------------------------------------------
    137 itcl::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 # ----------------------------------------------------------------------
    154 itcl::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 # ----------------------------------------------------------------------
    171 itcl::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?
     119    clear
     120}
     121
     122# ----------------------------------------------------------------------
     123# USAGE: add ?<testObj> <testObj> ...?
     124#
     125# Adds one or more Test objects to the tree shown in this viewer.
     126# Once added, these objects become property of this widget and
     127# are destroyed when the widget is cleared or deleted.
     128# ----------------------------------------------------------------------
     129itcl::body Rappture::Tester::TestTree::add {args} {
     130    set icon [Rappture::icon testcase]
     131
     132    foreach obj $args {
     133        if {[catch {$obj isa Rappture::Tester::Test} valid] || !$valid} {
     134            error "bad value \"$obj\": should be Test object"
     135        }
     136
     137        # add each Test object into the tree
     138        set testpath [$obj getTestInfo test.label]
     139        set n [$itk_component(treeview) insert end $testpath \
     140             -data [list test $obj] -icons [list $icon $icon]]
     141
     142        # tag this node so we can find it easily later
     143        $itk_component(treeview) tag add $obj $n
     144
     145        # monitor state changes on the object
     146        $obj configure -notifycommand [itcl::code $this _refresh]
     147    }
     148}
     149
     150# ----------------------------------------------------------------------
     151# USAGE: clear
     152#
     153# Clears the contents of the tree so that it's completely empty.
     154# All Test objects stored internally are destroyed.
     155# ----------------------------------------------------------------------
     156itcl::body Rappture::Tester::TestTree::clear {} {
     157    foreach id [_getLeaves] {
     158        itcl::delete object [_getTest $id]
     159    }
     160    $itk_component(treeview) delete 0
     161}
     162
     163# ----------------------------------------------------------------------
     164# USAGE: curselection
     165#
     166# Returns a list ids for all currently selected tests (leaf nodes) and
     167# the child tests of any currently selected branch nodes.  Tests can
     168# only be leaf nodes in the tree (the ids in the returned list will
     169# correspond to leaf nodes only).
     170# ----------------------------------------------------------------------
     171itcl::body Rappture::Tester::TestTree::curselection {} {
     172    set rlist ""
     173    foreach id [$itk_component(treeview) curselection] {
     174        foreach node [_getLeaves $id] {
     175            catch {unset data}
     176            array set data [$itk_component(treeview) entry cget $node -data]
     177
     178            if {[lsearch -exact $rlist $data(test)] < 0} {
     179                lappend rlist $data(test)
     180            }
     181        }
     182    }
     183    return $rlist
     184}
     185
     186# ----------------------------------------------------------------------
     187# USAGE _getTest <nodeId>
    178188#
    179189# Returns the test object associated with a given treeview node id.  If
    … …  
    182192# branch node.
    183193# ----------------------------------------------------------------------
    184 itcl::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} {
     194itcl::body Rappture::Tester::TestTree::_getTest {id} {
     195    if {[lsearch -exact [_getLeaves] $id] < 0} {
    194196        # Return empty string if branch node selected
    195197        return ""
    196198    }
     199    array set darray [$itk_component(treeview) entry cget $id -data]
    197200    return $darray(test)
    198201}
    199202
    200203# ----------------------------------------------------------------------
    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 # ----------------------------------------------------------------------
    209 itcl::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 # ----------------------------------------------------------------------
    233 itcl::body Rappture::Tester::TestTree::getData {id} {
    234     return [$itk_component(treeview) entry cget $id -data]
    235 }
    236 
    237 # ----------------------------------------------------------------------
    238 # USAGE: getLeaves ?id?
     204# USAGE: _refresh ?<testObj> <testObj> ...?
     205#
     206# Invoked whenever the state of a <testObj> changes.  Finds the
     207# corresponding entry in the tree and updates the "Result" column
     208# to show the new status.
     209# ----------------------------------------------------------------------
     210itcl::body Rappture::Tester::TestTree::_refresh {args} {
     211    foreach obj $args {
     212        set n [$itk_component(treeview) index $obj]
     213        if {$n ne ""} {
     214            catch {unset data}
     215            array set data [$itk_component(treeview) entry cget $n -data]
     216
     217            # getting rid of a spinner? then drop it
     218            if {[info exists data(result)]
     219                  && $data(result) == "@$spinner(image)"} {
     220                spinner drop
     221            }
     222
     223            # plug in the new icon
     224            switch -- [$obj getResult] {
     225                Pass    { set data(result) "@[Rappture::icon pass16]" }
     226                Fail    { set data(result) "@[Rappture::icon fail16]" }
     227                Waiting { set data(result) "@[Rappture::icon wait]" }
     228                Running { set data(result) "@[spinner use]" }
     229                default { set data(result) "" }
     230            }
     231puts "ICON: $data(result)"
     232            $itk_component(treeview) entry configure $n -data [array get data]
     233        }
     234    }
     235}
     236
     237# ----------------------------------------------------------------------
     238# USAGE: _getLeaves ?id?
    239239#
    240240# Returns a list of ids for all tests contained in the tree.  If an
    … …  
    243243# id.  Tests can only be leaf nodes.
    244244# ----------------------------------------------------------------------
    245 itcl::body Rappture::Tester::TestTree::getLeaves {{id 0}} {
     245itcl::body Rappture::Tester::TestTree::_getLeaves {{id 0}} {
    246246    set clist [$itk_component(treeview) entry children $id]
    247247    if {$clist == "" && $id == 0} {
    … …  
    254254    set tests [list]
    255255    foreach child $clist {
    256         set tests [concat $tests [getLeaves $child]]
     256        set tests [concat $tests [_getLeaves $child]]
    257257    }
    258258    return $tests
    … …  
    260260
    261261# ----------------------------------------------------------------------
    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 # ----------------------------------------------------------------------
    269 itcl::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 # ----------------------------------------------------------------------
    291 itcl::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 # ----------------------------------------------------------------------
    326 itcl::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 # ----------------------------------------------------------------------
    343 itcl::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 # ----------------------------------------------------------------------
    359 itcl::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 # ----------------------------------------------------------------------
    370 itcl::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 
     262# USAGE: spinner use|drop|next
     263#
     264# Used to update the spinner icon that represents running test cases.
     265# The "use" option returns the spinner icon and starts the animation,
     266# if it isn't already running.  The "drop" operation lets go of the
     267# spinner.  If nobody is using it, the animation stops.  The "next"
     268# option is used internally to change the animation to the next frame.
     269# ----------------------------------------------------------------------
     270itcl::body Rappture::Tester::TestTree::spinner {op} {
     271    switch -- $op {
     272        use {
     273            if {$spinner(pending) == ""} {
     274                set spinner(current) 0
     275                set spinner(pending) [after 100 Rappture::Tester::TestTree::spinner next]
     276            }
     277            incr spinner(uses)
     278            return $spinner(image)
     279        }
     280        drop {
     281            if {[incr spinner(uses) -1] <= 0} {
     282                after cancel $spinner(pending)
     283                set spinner(pending) ""
     284                set spinner(uses) 0
     285            }
     286        }
     287        next {
     288            set n $spinner(current)
     289            $spinner(image) copy $spinner(frame$n)
     290
     291            # go to the next frame
     292            if {[incr spinner(current)] >= $spinner(frames)} {
     293                set spinner(current) 0
     294            }
     295
     296            # update again after a short delay
     297            set spinner(pending) [after 100 Rappture::Tester::TestTree::spinner next]
     298        }
     299        default {
     300            error "bad option \"$op\": should be use, drop, next"
     301        }
     302    }
     303}

  • trunk/tester/testview.tcl

    r2074 r2077  
    22#  COMPONENT: testview - display the results of a test
    33#
    4 #  Entire right hand side of the regression tester.  Displays the
    5 #  golden test results, and compares them to the new results if the test
    6 #  has been ran.  Also show tree representation of all inputs and
    7 #  outputs.  The -test configuration option is used to provide a Test
    8 #  object to display.
     4#  Top part of right hand side of the regression tester.  Displays an
     5#  overview of selected test cases, and offers a button for running
     6#  them.
    97# ======================================================================
    108#  AUTHOR:  Ben Rafferty, Purdue University
    11 #  Copyright (c) 2010  Purdue Research Foundation
     9#           Michael McLennan, Purdue University
     10#  Copyright (c) 2010-2011  Purdue Research Foundation
    1211#
    1312#  See the file "license.terms" for information on usage and
    … …  
    1918namespace eval Rappture::Tester::TestView { #forward declaration }
    2019
    21 option add *TestView.font \
    22     -*-helvetica-medium-r-normal-*-12-* widgetDefault
    23 option add *TestView.codeFont \
    24     -*-courier-medium-r-normal-*-12-* widgetDefault
    25 option add *TestView.textFont \
    26     -*-helvetica-medium-r-normal-*-12-* widgetDefault
    27 option add *TestView.boldTextFont \
    28     -*-helvetica-bold-r-normal-*-12-* widgetDefault
     20option add *TestView.font {Arial -12} widgetDefault
     21option add *TestView.titleFont {Arial -18 bold} widgetDefault
     22option add *TestView.statusFont {Arial -12 italic} widgetDefault
     23option add *TestView.statusPassColor black widgetDefault
     24option add *TestView.statusFailColor red widgetDefault
     25option add *TestView*descScroller.width 3i widgetDefault
     26option add *TestView*descScroller.height 1i widgetDefault
    2927
    3028itcl::class Rappture::Tester::TestView {
    3129    inherit itk::Widget
    3230
    33     itk_option define -test test Test ""
     31    itk_option define -statuspasscolor statusPassColor StatusColor ""
     32    itk_option define -statusfailcolor statusFailColor StatusColor ""
     33    itk_option define -runcommand runCommand RunCommand ""
    3434
    3535    constructor {args} { #defined later }
    36 
    37     protected method reset
    38     protected method showDescription {text}
    39     protected method showStatus {text}
    40     protected method updateResults {}
    41     protected method updateInputs {}
    42     protected method updateOutputs {}
    43 
     36    public method show {args}
     37
     38    private method _doRun {}
     39    private method _plural {n}
     40
     41    private variable _testobjs ""  ;# objects being displayed
    4442}
    4543
    … …  
    4947itcl::body Rappture::Tester::TestView::constructor {args} {
    5048
    51     itk_component add status {
    52         label $itk_interior.status
    53     }
    54     pack $itk_component(status) -expand no -fill none -side top -anchor w
    55 
     49    # run button to run selected tests
     50    itk_component add run {
     51        button $itk_interior.run -text "Run" -padx 12 -pady 12 \
     52            -command [itcl::code $this _doRun]
     53    }
     54    pack $itk_component(run) -side right -anchor n
     55
     56    # shows the big icon for test: pass/fail
     57    itk_component add statusicon {
     58        label $itk_interior.sicon
     59    }
     60    pack $itk_component(statusicon) -side left -anchor n
     61
     62    # shows the name of the test
     63    itk_component add title {
     64        label $itk_interior.title -anchor w
     65    } {
     66        usual
     67        rename -font -titlefont titleFont Font
     68    }
     69    pack $itk_component(title) -side top -anchor w
     70
     71    # shows the status of the test: pass/fail
     72    itk_component add statusmesg {
     73        label $itk_interior.smesg -anchor w
     74    } {
     75        usual
     76        rename -font -statusfont statusFont Font
     77        ignore -foreground
     78    }
     79    pack $itk_component(statusmesg) -side top -anchor w
     80
     81    # for the longer text describing the test
    5682    itk_component add descScroller {
    5783        Rappture::Scroller $itk_interior.descScroller \
    5884            -xscrollmode auto -yscrollmode auto
    5985    }
     86    pack $itk_component(descScroller) -expand yes -fill both
    6087
    6188    itk_component add description {
    62         text $itk_interior.descScroller.description -height 0 -wrap word \
    63             -relief flat
     89        text $itk_component(descScroller).desc -height 1 \
     90            -wrap word -relief flat
    6491    }
    6592    $itk_component(descScroller) contents $itk_component(description)
    66     pack $itk_component(descScroller) -expand no -fill x -side top
    67 
    68     itk_component add tabs {
    69         blt::tabset $itk_interior.tabs -borderwidth 0 -relief flat \
    70             -side left -tearoff 0 -highlightthickness 0 \
    71             -selectbackground $itk_option(-background)
    72     } {
    73     }
    74     $itk_component(tabs) insert end "Results" -ipady 25 -fill both
    75     $itk_component(tabs) insert end "Inputs" -ipady 25 -fill both \
    76         -state disabled
    77     $itk_component(tabs) insert end "Outputs" -ipady 25 -fill both \
    78         -state disabled
    79 
    80     itk_component add results {
    81         Rappture::ResultsPage $itk_component(tabs).results
    82     }
    83     $itk_component(tabs) tab configure "Results" \
    84         -window $itk_component(tabs).results
    85 
    86     itk_component add inputScroller {
    87         Rappture::Scroller $itk_component(tabs).inputScroller \
    88             -xscrollmode auto -yscrollmode auto
    89     }
    90 
    91     itk_component add inputs {
    92         blt::treeview $itk_component(inputScroller).inputs -separator . \
    93             -autocreate true
    94     } {
    95         keep -foreground -font -cursor
    96     }
    97     $itk_component(inputs) column insert end "Value"
    98     $itk_component(inputScroller) contents $itk_component(inputs)
    99     $itk_component(tabs) tab configure "Inputs" \
    100         -window $itk_component(inputScroller)
    101 
    102     itk_component add outputScroller {
    103         Rappture::Scroller $itk_component(tabs).outputScroller \
    104             -xscrollmode auto -yscrollmode auto
    105     }
    106 
    107     itk_component add outputs {
    108         blt::treeview $itk_component(outputScroller).outputs -separator . \
    109             -autocreate true
    110     } {
    111         keep -foreground -font -cursor
    112     }
    113     $itk_component(outputs) column insert end "Status"
    114     $itk_component(outputScroller) contents $itk_component(outputs)
    115     $itk_component(tabs) tab configure "Outputs" \
    116         -window $itk_component(outputScroller)
    117 
    118     pack $itk_component(tabs) -expand yes -fill both -side top
    11993
    12094    eval itk_initialize $args
    121 
    122 }
    123 
    124 # ----------------------------------------------------------------------
    125 # CONFIGURATION OPTION: -test
    126 #
    127 # When the -test configuration option is modified, update the display
    128 # accordingly.  The data passed in should be a Test object, or an empty
    129 # string to clear the display.
    130 # ----------------------------------------------------------------------
    131 itcl::configbody Rappture::Tester::TestView::test {
    132     set test $itk_option(-test)
    133     # If an empty string is passed in then clear everything
    134     if {$test == ""} {
    135         reset
     95}
     96
     97itk::usual TestView {
     98    keep -background -foreground -cursor
     99    keep -font -titlefont -statusfont
     100}
     101
     102# ----------------------------------------------------------------------
     103# USAGE: show <testObj> <testObj> ...
     104#
     105# Loads one or more Test objects into the display.  When a single
     106# object is shown, we can display more detail.  When several objects
     107# are shown, we provide overview info.
     108# ----------------------------------------------------------------------
     109itcl::body Rappture::Tester::TestView::show {args} {
     110    foreach obj $args {
     111        if {[catch {$obj isa Test} valid] || !$valid} {
     112            error "bad value \"$obj\": should be Test object"
     113        }
     114    }
     115    set _testobjs $args
     116
     117    switch -- [llength $_testobjs] {
     118        0 {
     119            # If an empty string is passed in then clear everything
     120            $itk_component(title) configure -text ""
     121            $itk_component(statusicon) configure -image ""
     122            $itk_component(statusmesg) configure -text ""
     123            $itk_component(description) configure -state normal
     124            $itk_component(description) delete 1.0 end
     125            $itk_component(description) configure -state disabled
     126            $itk_component(run) configure -state disabled
     127        }
     128        1 {
     129            set obj [lindex $_testobjs 0]
     130            switch [$obj getResult] {
     131                ? {
     132                    set smesg "Ready to run"
     133                    set sicon [Rappture::icon test64]
     134                    set color $itk_option(-statuspasscolor)
     135                }
     136                Pass {
     137                    set smesg "Test passed"
     138                    set sicon [Rappture::icon pass64]
     139                    set color $itk_option(-statuspasscolor)
     140                }
     141                Fail {
     142                    set smesg "Test failed"
     143                    set sicon [Rappture::icon fail64]
     144                    set color $itk_option(-statusfailcolor)
     145                }
     146                default { error "unknown test state \"[$obj getResult]\"" }
     147            }
     148            set name [lindex [split [$obj getTestInfo test.label] |] end]
     149            $itk_component(title) configure -text "Test: $name"
     150            $itk_component(statusicon) configure -image $sicon
     151            $itk_component(statusmesg) configure -text $smesg -foreground $color
     152            $itk_component(description) configure -state normal
     153            $itk_component(description) delete 1.0 end
     154            set desc [string trim [$obj getTestInfo test.description]]
     155            if {$desc eq ""} {
     156                set desc "--"
     157            }
     158            $itk_component(description) insert 1.0 $desc
     159            $itk_component(description) configure -state disabled
     160            $itk_component(run) configure -state normal
     161        }
     162        default {
     163            array set states { ? 0  Pass 0  Fail 0  total 0 }
     164            foreach obj $_testobjs {
     165                incr states(total)
     166                incr states([$obj getResult])
     167            }
     168            if {$states(total) == 1} {
     169                set thistest "This test"
     170            } else {
     171                set thistest "These tests"
     172            }
     173
     174            $itk_component(title) configure \
     175                -text [string totitle [_plural $states(total)]]
     176
     177            switch -glob -- $states(Pass)/$states(Fail)/$states(?) {
     178                0/0/* {
     179                    set smesg "Ready to run"
     180                    set sicon [Rappture::icon test64]
     181                    set color $itk_option(-statuspasscolor)
     182                    set desc ""
     183                }
     184                */0/0 {
     185                    set smesg "$thistest passed"
     186                    set sicon [Rappture::icon pass64]
     187                    set color $itk_option(-statuspasscolor)
     188                    set desc ""
     189                }
     190                0/*/0 {
     191                    set smesg "$thistest failed"
     192                    set sicon [Rappture::icon fail64]
     193                    set color $itk_option(-statusfailcolor)
     194                    set desc ""
     195                }
     196                0/*/* {
     197                    if {$states(Fail) == 1} {
     198                        set smesg "One of these tests failed"
     199                    } else {
     200                        set smesg "Some of these tests failed"
     201                    }
     202                    set sicon [Rappture::icon fail64]
     203                    set color $itk_option(-statusfailcolor)
     204                    set desc "[_plural $states(Fail)] failed\n[_plural $states(?)] need to run"
     205                }
     206                */*/0 {
     207                    if {$states(Pass) == 1} {
     208                        set smesg "One of these tests passed"
     209                    } else {
     210                        set smesg "Some of these tests passed"
     211                    }
     212                    set sicon [Rappture::icon test64]
     213                    set color $itk_option(-statuspasscolor)
     214                    set desc "[_plural $states(Fail)] failed\n[_plural $states(Pass)] passed"
     215                }
     216                default {
     217                    set smesg "Some tests passed, some failed"
     218                    set sicon [Rappture::icon fail64]
     219                    set color $itk_option(-statusfailcolor)
     220                    set desc "[_plural $states(Fail)] failed\n[_plural $states(Pass)] passed\n[_plural $states(?)] need to run"
     221                }
     222            }
     223            $itk_component(statusicon) configure -image $sicon
     224            $itk_component(statusmesg) configure -text $smesg -foreground $color
     225            $itk_component(description) configure -state normal
     226            $itk_component(description) delete 1.0 end
     227            $itk_component(description) insert end $desc
     228            $itk_component(description) configure -state disabled
     229            $itk_component(run) configure -state normal
     230        }
     231    }
     232}
     233
     234# ----------------------------------------------------------------------
     235# USAGE: _doRun
     236#
     237# Invoked when the user presses the "Run" button to invoke the
     238# -runcommand script for this widget.  Invokes the command with
     239# the current test objects appended as arguments.
     240# ----------------------------------------------------------------------
     241itcl::body Rappture::Tester::TestView::_doRun {} {
     242    if {[string length $itk_option(-runcommand)] > 0} {
     243        uplevel #0 $itk_option(-runcommand) $_testobjs
     244    }
     245}
     246
     247# ----------------------------------------------------------------------
     248# USAGE: _plural <num>
     249#
     250# Handy way of generating a plural string.  If <num> is 1, it returns
     251# "1 test".  Otherwise it returns "<num> tests".
     252# ----------------------------------------------------------------------
     253itcl::body Rappture::Tester::TestView::_plural {num} {
     254    if {$num == 1} {
     255        return "1 test"
    136256    } else {
    137         if {![$test isa Test]} {
    138             error "-test option must be a Test object.  $test was given."
    139         }
    140         if {[$test hasRan]} {
    141             switch [$test getResult] {
    142                 Pass {showStatus "Test passed."}
    143                 Fail {showStatus "Test failed."}
    144                 Error {showStatus "Error while running test."}
    145             }
    146         } else {
    147             showStatus "Test has not yet run."
    148         }
    149         updateResults
    150         updateInputs
    151         updateOutputs
    152         set descr [[$test getTestobj] get test.description]
    153         if {$descr == ""} {
    154             set descr "No description."
    155         }
    156         showDescription $descr
    157     }
    158 }
    159 
    160 itk::usual TestView {
    161     keep -background -foreground -font
    162 }
    163 
    164 # ----------------------------------------------------------------------
    165 # USAGE: reset
    166 #
    167 # Resets the entire TestView widget back to the default state.
    168 # ----------------------------------------------------------------------
    169 itcl::body Rappture::Tester::TestView::reset {} {
    170     updateResults
    171     updateInputs
    172     updateOutputs
    173     showStatus ""
    174     showDescription ""
    175 }
    176 
    177 # ----------------------------------------------------------------------
    178 # USAGE: showDescription <text>
    179 #
    180 # Displays a string in the description text space near the top of the
    181 # widget.  If given an empty string, disable the sunken relief effect
    182 # to partially hide the text box.
    183 # ----------------------------------------------------------------------
    184 itcl::body Rappture::Tester::TestView::showDescription {text} {
    185     $itk_component(description) configure -state normal
    186     $itk_component(description) delete 0.0 end
    187     $itk_component(description) insert end "$text"
    188     $itk_component(description) configure -state disabled
    189     if {$text == ""} {
    190         $itk_component(description) configure -relief flat
    191     } else {
    192         $itk_component(description) configure -relief sunken
    193     }
    194 }
    195 
    196 # ----------------------------------------------------------------------
    197 # USAGE: showStatus <text>
    198 #
    199 # Displays a string in the status info space at the top of the widget.
    200 # ----------------------------------------------------------------------
    201 itcl::body Rappture::Tester::TestView::showStatus {text} {
    202     $itk_component(status) configure -text "$text"
    203 }
    204 
    205 # ----------------------------------------------------------------------
    206 # USAGE: updateResults
    207 
    208 # Used internally to update the results tab according to the test
    209 # currently specified by the -test configuration option.  Show the
    210 # golden results contained in the test xml, and if the the test has been
    211 # ran, show the new results as well.
    212 # ----------------------------------------------------------------------
    213 itcl::body Rappture::Tester::TestView::updateResults {} {
    214     $itk_component(results) clear -nodelete
    215     set test $itk_option(-test)
    216     if {$test == ""} {
    217         # Already cleared, do nothing.
    218         # TODO: Eventually display some kinds of message here.
    219     } else {
    220         set test $itk_option(-test)
    221         $itk_component(results) load [$test getTestobj]
    222         if {[$test hasRan]  && [Rappture::library isvalid [$test getRunobj]]} {
    223             $itk_component(results) load [$test getRunobj]
    224         }
    225     }
    226 }
    227 
    228 # ----------------------------------------------------------------------
    229 # USAGE: updateInputs
    230 #
    231 # Used internally to update the inputs tab according to the test
    232 # currently specified by the -test configuration option.  Shows a tree
    233 # representation of all inputs given in the test xml and their given
    234 # values.
    235 # ----------------------------------------------------------------------
    236 itcl::body Rappture::Tester::TestView::updateInputs {} {
    237     $itk_component(inputs) delete 0
    238     set test $itk_option(-test)
    239     if {$test != ""} {
    240         $itk_component(tabs) tab configure "Inputs" -state normal
    241         foreach pair [$test getInputs] {
    242             set path [lindex $pair 0]
    243             set val [lindex $pair 1]
    244             $itk_component(inputs) insert end $path -data [list Value $val]
    245         }
    246         $itk_component(inputs) open -recurse root
    247     }
    248 }
    249 
    250 # ----------------------------------------------------------------------
    251 # USAGE: updateOutputs
    252 #
    253 # Used internally to update the outputs tab according to the test
    254 # currently specified by the -test configuration option.  Shows a tree
    255 # representation of all outputs in the runfile generated by the last run
    256 # of the test, along with their status (ok, diff, added, or missing).
    257 # Disable the outputs tab if test has not been ran, or resulted in an
    258 # error.
    259 # ----------------------------------------------------------------------
    260 itcl::body Rappture::Tester::TestView::updateOutputs {} {
    261     $itk_component(outputs) delete 0
    262     set test $itk_option(-test)
    263     if {$test != "" && [$test hasRan] && [$test getResult] != "Error"} {
    264         $itk_component(tabs) tab configure "Outputs" -state normal
    265         foreach pair [$test getOutputs] {
    266             set path [lindex $pair 0]
    267             set status [lindex $pair 1]
    268             $itk_component(outputs) insert end $path -data [list Status $status]
    269         }
    270         $itk_component(outputs) open -recurse root
    271     } else {
    272         $itk_component(tabs) tab configure "Outputs" -state disabled
    273         # Switch back to results tab if the outputs tab is open and the
    274         # selected test has not been ran.
    275         if {[$itk_component(tabs) index select] == \
    276             [$itk_component(tabs) index -name "Outputs"]} {
    277             set index [$itk_component(tabs) index -name "Results"]
    278             $itk_component(tabs) select $index
    279             $itk_component(tabs) focus $index
    280         }
    281     }
    282 }
    283        
    284        
    285 
     257        return "$num tests"
     258    }
     259}
Note: See TracChangeset for help on using the changeset viewer.