Changeset 2139 for trunk/tester/scripts


Ignore:
Timestamp:
Mar 18, 2011 8:45:29 AM (9 years ago)
Author:
mmc
Message:

Finished everything for a 1.0 version of the tester tool. The tester
successfully reports errors for the tool in the "example" directory.
It catches differences in input values and output results. It can look
for tests that are expected to fail and detect mismatches in their
standard output. Still needs a "build" mode to create/modify tests,
but this much handles the regression testing part pretty well.

Location:
trunk/tester/scripts
Files:
2 added
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/tester/scripts/main.tcl

    r2136 r2139  
    4444option add *Progress.barColor #ffffcc
    4545option add *Diffview.background white
     46option add *Text.background white
    4647option add *Balloon.titleBackground #6666cc
    4748option add *Balloon.titleForeground white
     
    133134set xmlobj [Rappture::library $params(-tool)]
    134135set ToolObj [Rappture::Tool ::#auto $xmlobj $installdir]
     136set DiffShow ""  ;# used to track which diff objects are being displayed
    135137
    136138# ----------------------------------------------------------------------
     
    210212
    211213# show add/deleted styles at the bottom
    212 frame .testdiffs.legend
     214Rappture::Tester::Legend .testdiffs.legend
    213215pack .testdiffs.legend -side bottom -fill x
    214 frame .testdiffs.legend.line -height 1 -background black
    215 pack .testdiffs.legend.line -side top -fill x -pady {0 2}
    216 label .testdiffs.legend.lleg -text "Legend: "
    217 pack .testdiffs.legend.lleg -side left
    218 frame .testdiffs.legend.add -width 16 -height 16 -borderwidth 1 -relief solid
    219 pack .testdiffs.legend.add -side left -padx {6 0}
    220 label .testdiffs.legend.addl -text "= Added"
    221 pack .testdiffs.legend.addl -side left
    222 frame .testdiffs.legend.del -width 16 -height 16 -borderwidth 1 -relief solid
    223 pack .testdiffs.legend.del -side left -padx {10 0}
    224 label .testdiffs.legend.dell -text "= Deleted"
    225 pack .testdiffs.legend.dell -side left
     216frame .testdiffs.line -height 1 -background black
     217pack .testdiffs.line -side bottom -fill x -pady {0 2}
    226218
    227219# diff viewer goes in this spot
     
    231223# viewer for attribute diffs
    232224Rappture::Tester::ObjView .testdiffs.body.attrs
     225
     226# viewer for run status diffs
     227Rappture::Tester::RunView .testdiffs.body.runs
    233228
    234229# viewer for value diffs where object is extra or missing
     
    259254pack .testdiffs.body.val2strs.diffs -expand yes -fill both -padx 10 -pady 10
    260255
     256# viewer for value diffs where we have a special object viewer
     257Rappture::Panes .testdiffs.body.val2objs -orientation horizontal -sashcursor sb_h_double_arrow
     258
     259# empty area for the object value viewer
     260set win [.testdiffs.body.val2objs pane 0]
     261frame $win.val
     262pack $win.val -expand yes -fill both
     263
     264# show object details and diff on the right-hand side
     265set win [.testdiffs.body.val2objs insert end -fraction 0.5]
     266Rappture::Tester::ObjView $win.obj -details min -showdiffs no
     267pack $win.obj -side top -fill x
     268Rappture::Tester::StringDiffs $win.diffs \
     269    -title1 "Expected this:" -title2 "Got this:"
     270pack $win.diffs -expand yes -fill both -padx 4 -pady 4
     271
    261272# plug the proper diff colors into the legend area
    262 .testdiffs.legend.add configure \
    263     -background [.testdiffs.body.attrs cget -addedbackground]
    264 .testdiffs.legend.del configure \
    265     -background [.testdiffs.body.attrs cget -deletedbackground]
     273.testdiffs.legend insert end -title "= Added" -shape box \
     274    -color [.testdiffs.body.val2strs.diffs cget -addedbackground]
     275.testdiffs.legend insert end -title "= Deleted" -shape box \
     276    -color [.testdiffs.body.val2strs.diffs cget -deletedbackground]
     277.testdiffs.legend insert end -title "= Changed" -shape box \
     278    -color [.testdiffs.body.val2strs.diffs cget -changedbackground]
     279.testdiffs.legend insert end -title "= Test Result" -shape line \
     280    -color red -anchor e
     281.testdiffs.legend insert end -title "= Expected Result" -shape line \
     282    -color black -anchor e
    266283
    267284# Load all tests in the test directory
     
    400417                    }
    401418                  }
     419                  status {
     420                    set icon [Rappture::icon fail16]
     421                    set title "Run failure"
     422                    if {$diff(-path) eq "output.status"} {
     423                        set desc "Test run failure was not expected"
     424                        set help "The test run failed, but the test case was expected to finish successfully.  The tool should be fixed to avoid the failure.  If you can verify that the tool is working correctly, then the test case should be updated to contain this new result."
     425                    } else {
     426                        set desc "Test run failure produced different output"
     427                        set help "The test run failed as expected, but produced different output.  Fix the tool to produce the correct error message for the failure.  If you can verify that the latest error message is better, then the test case should be updated to contain this new output."
     428                    }
     429                  }
    402430                  default {
    403431                    error "don't know how to handle difference \"$what\""
     
    513541# ----------------------------------------------------------------------
    514542proc tester_diff_show {args} {
    515     global Viewers
     543    global DiffShow
    516544
    517545    set testtree [.pw pane 0].tree
    518546    set rhs [.pw pane 1]
    519547    set testview $rhs.testview
    520 
    521     # show the test data in the header -- doesn't accept the -index, though
     548    set viewarea [.testdiffs.body.val2objs pane 0].val
     549
     550    # clean up from the last call
     551    set viewer [lindex $DiffShow 0]
     552    if {$viewer ne ""} {
     553        $viewer delete
     554        foreach obj [lrange $DiffShow 1 end] {
     555            itcl::delete object $obj
     556        }
     557    }
     558    set DiffShow ""
     559
     560    # show the diff overview in the header
    522561    array set data $args
    523 puts "SHOW: [array get data]"
    524562    .testdiffs.hd.inner.title configure -image $data(-icon) -text $data(-body)
    525563
     
    536574
    537575    switch -glob -- $diff(-what) {
    538         "value +" {
     576        "value *" {
     577            foreach w [pack slaves $viewarea] {
     578                pack forget $w
     579            }
     580
     581            set op [lindex $diff(-what) 1]
     582            set w .testdiffs.body.val1str.obj
     583            switch -- $op {
     584                +       { set bg [$w cget -addedbackground] }
     585                -       { set bg [$w cget -deletedbackground] }
     586                default { set bg [lindex [$w configure -background] 3] }
     587            }
     588
     589            # get the first value in obj or string form
     590            set val1 ""
     591            if {[catch {Rappture::objects::import $diff(-obj1) $diff(-path)} val1] == 0 && $val1 ne ""} {
     592                set viewer [Rappture::objects::viewer $val1 \
     593                    -for output -parent $viewarea]
     594                if {$viewer ne ""} {
     595                    set DiffShow [list $viewer $val1]
     596                }
     597                # try to get a string rep too
     598                set status [$val1 export string str]
     599                if {[lindex $status 0]} { set vstr1 $str }
     600            }
     601
    539602            # get a string rep for the second value
     603            set val2 ""
    540604            if {[catch {Rappture::objects::import $diff(-obj2) $diff(-path)} val2] == 0 && $val2 ne ""} {
     605                set viewer [Rappture::objects::viewer $val2 \
     606                    -for output -parent $viewarea]
     607                if {$viewer ne ""} {
     608                    if {$DiffShow ne ""} {
     609                        if {[lindex $DiffShow 0] eq $viewer} {
     610                            lappend DiffShow $val2
     611                        } else {
     612                            error "type mismatch between values: $diff(-obj1) vs $diff(-obj2) -- diff should have caught this as \"type\" difference"
     613                        }
     614                    } else {
     615                        set DiffShow [list $viewer $val2]
     616                    }
     617                }
     618                # try to get a string rep too
    541619                set status [$val2 export string str]
    542                 if {[lindex $status 0]} {
    543                     set v2 $str
     620                if {[lindex $status 0]} { set vstr2 $str }
     621            }
     622
     623            if {$DiffShow ne ""} {
     624                # we have a value viewer -- show the values in that
     625                pack $viewer -expand yes -fill both
     626
     627                if {$val1 ne ""} {
     628                    $viewer add $val1 [list -color black -description "Expected Result"]
    544629                }
    545                 itcl::delete object $val2
    546             }
    547 
    548             if {[info exists v2]} {
    549                 # we have a value -- show it
     630                if {$val2 ne ""} {
     631                    $viewer add $val2 [list -color red -description "Test Result"]
     632                }
     633
     634                # show the string diffs too
     635                set w [.testdiffs.body.val2objs pane 1]
     636                $w.obj configure -background $bg \
     637                    -testobj $diff(-testobj) -path $diff(-path)
     638
     639                if {[info exists vstr1]} { set v1 $vstr1 } else { set v1 "" }
     640                if {[info exists vstr2]} { set v2 $vstr2 } else { set v2 "" }
     641                $w.diffs show $v1 $v2
     642
     643                set win .testdiffs.body.val2objs
     644
     645                set legsettings [list 2 normal \
     646                    3 [expr {($val2 ne "") ? "normal" : "disabled"}] \
     647                    4 [expr {($val1 ne "") ? "normal" : "disabled"}]]
     648
     649            } elseif {[info exists vstr1] && [info exists vstr2]} {
     650                # we have two value strings -- show as a diff
     651                set win .testdiffs.body.val2strs
     652                $win.obj configure -background $bg \
     653                    -testobj $diff(-testobj) -path $diff(-path)
     654                $win.diffs show $vstr1 $vstr2
     655                set legsettings {2 normal 3 disabled 4 disabled}
     656            } elseif {[info exists vstr1] || [info exists vstr2]} {
     657                # we have one value string -- show it
     658                if {[info exists vstr1]} {
     659                    set val $vstr1
     660                } else {
     661                    set val $vstr2
     662                }
    550663                set win .testdiffs.body.val1str
    551                 set bg [$win.obj cget -addedbackground]
    552664                $win.obj configure -background $bg \
    553665                    -testobj $diff(-testobj) -path $diff(-path)
    554666                $win.scrl.text configure -state normal
    555667                $win.scrl.text delete 1.0 end
    556                 $win.scrl.text insert end $v2
    557                 $win.scrl.text configure -state disabled -background $bg
     668                $win.scrl.text insert end $val
     669                $win.scrl.text configure -state disabled
     670                set legsettings {2 disabled 3 disabled 4 disabled}
    558671            } else {
    559672                # don't have a value -- show the attributes
    560673                set win .testdiffs.body.val
    561                 set bg [$win.obj cget -addedbackground]
    562674                $win.obj configure -background $bg \
    563675                    -testobj $diff(-testobj) -path $diff(-path)
    564             }
    565         }
    566         "value -" {
    567             # get a string rep for the first value
    568             if {[catch {Rappture::objects::import $diff(-obj1) $diff(-path)} val1] == 0 && $val1 ne ""} {
    569                 set status [$val1 export string str]
    570                 if {[lindex $status 0]} {
    571                     set v1 $str
    572                 }
     676                set legsettings {2 disabled 3 disabled 4 disabled}
     677            }
     678
     679            # clean up any objects that are not being stored
     680            if {$val1 ne "" && [lsearch $DiffShow $val1] < 0} {
    573681                itcl::delete object $val1
    574682            }
    575 
    576             if {[info exists v1]} {
    577                 # we have a value -- show it
    578                 set win .testdiffs.body.val1str
    579                 set bg [$win.obj cget -deletedbackground]
    580                 $win.obj configure -background $bg \
    581                     -testobj $diff(-testobj) -path $diff(-path)
    582                 $win.scrl.text configure -state normal
    583                 $win.scrl.text delete 1.0 end
    584                 $win.scrl.text insert end $v1
    585                 $win.scrl.text configure -state disabled -background $bg
    586             } else {
    587                 # don't have a value -- show the attributes
    588                 set win .testdiffs.body.val
    589                 set bg [$win.obj cget -deletedbackground]
    590                 $win.obj configure -background $bg \
    591                     -testobj $diff(-testobj) -path $diff(-path)
    592             }
    593         }
    594         "value c" {
    595             set win .testdiffs.body.val2strs
    596             set bg [lindex [$win.obj configure -background] 3]
    597            
    598             $win.obj configure -background $bg \
    599                 -testobj $diff(-testobj) -path $diff(-path)
    600 
    601             # get a string rep for the first value
    602             set v1 "???"
    603             if {[catch {Rappture::objects::import $diff(-obj1) $diff(-path)} val1] == 0 && $val1 ne ""} {
    604                 set status [$val1 export string str]
    605                 if {[lindex $status 0]} {
    606                     set v1 $str
    607                 }
    608                 itcl::delete object $val1
    609             }
    610 
    611             # get a string rep for the second value
    612             set v2 "???"
    613             if {[catch {Rappture::objects::import $diff(-obj2) $diff(-path)} val2] == 0 && $val2 ne ""} {
    614                 set status [$val2 export string str]
    615                 if {[lindex $status 0]} {
    616                     set v2 $str
    617                 }
     683            if {$val2 ne "" && [lsearch $DiffShow $val2] < 0} {
    618684                itcl::delete object $val2
    619685            }
    620 
    621             $win.diffs show $v1 $v2
    622686        }
    623687        "attrs *" {
     
    626690            $win configure -testobj $diff(-testobj) -background $bg \
    627691                -path $diff(-path) -details max -showdiffs yes
     692            set legsettings {2 disabled 3 disabled 4 disabled}
     693        }
     694        "status" {
     695            set win .testdiffs.body.runs
     696            $win configure -testobj $diff(-testobj) -showdiffs yes
     697            set legsettings {2 disabled 3 disabled 4 disabled}
    628698        }
    629699        "type *" {
    630700            error "don't know how to show type diffs"
     701            set legsettings {2 disabled 3 disabled 4 disabled}
    631702        }
    632703    }
     
    636707        }
    637708        pack $win -expand yes -fill both
     709    }
     710
     711    # fix up the legend to best explain the current result
     712    foreach {index state} $legsettings {
     713        .testdiffs.legend itemconfigure $index -state $state
    638714    }
    639715
     
    662738proc tester_regoldenize {} {
    663739    set testtree [.pw pane 0].tree
    664     set tests [$testtree curselection]
    665 
    666     if {[llength $tests] != 1} {
    667         error "Cannot regoldenize. One test must be selected"
    668     }
    669 
    670     set test [lindex $tests 0]
     740    set seltests [$testtree curselection]
     741
     742    if {[llength $seltests] != 1} {
     743        error "Oops! Multiple tests selected to regoldenize.  How did we get here?"
     744    }
     745
     746    set test [lindex $seltests 0]
    671747    set testxml [$test getTestxml]
    672748    if {[tk_messageBox -type yesno -icon warning -message "Are you sure you want to regoldenize?\n$testxml will be overwritten."]} {
     
    677753    }
    678754}
    679 
    680 # ----------------------------------------------------------------------
    681 # USAGE: tester_view_outputs
    682 #
    683 # Displays the outputs of the currently selected test case as they would
    684 # be seen when running the tool normally.  If the test has completed
    685 # with no error, then show the new outputs alongside the golden results.
    686 # ----------------------------------------------------------------------
    687 proc tester_view_outputs {} {
    688     set testtree [.pw pane 0].tree
    689     set rhs [.pw pane 1]
    690     set resultspage $rhs.testoutput.rp
    691     set tests [$testtree curselection]
    692 
    693     if {[llength $tests] != 1} {
    694         error "Cannot display outputs. One test must be selected"
    695     }
    696 
    697     # Unpack right hand side
    698     foreach win [pack slaves $rhs] {
    699         pack forget $win
    700     }
    701 
    702     # Clear any previously loaded outputs from the resultspage
    703     $resultspage clear -nodelete
    704 
    705     # Display testobj, and runobj if test has completed successfully
    706     set test [lindex $tests 0]
    707     $resultspage load [$test getTestobj]
    708     set result [$test getResult]
    709     if {$result ne "?" && $result ne "Error"} {
    710         $resultspage load [$test getRunobj]
    711     }
    712 
    713     pack $rhs.testoutput -expand yes -fill both -padx 8 -pady 8
    714 }
    715 
  • trunk/tester/scripts/objview.tcl

    r2136 r2139  
    104104    if {$testobj ne "" && $path ne ""} {
    105105        set type [$testobj getTestInfo element -as type $path]
     106        if {$type eq ""} {
     107            set type [$testobj getRunInfo element -as type $path]
     108        }
    106109    }
    107110
  • trunk/tester/scripts/statuslist.tcl

    r2136 r2139  
    5050    public method size {} { return [llength $_entries] }
    5151    public method get {pos args}
    52     public method invoke {{index "current"}}
    5352    public method view {{index "current"}}
    5453
  • trunk/tester/scripts/stringdiffs.tcl

    r2136 r2139  
    1919option add *StringDiffs.titleFont {Arial -12 bold} widgetDefault
    2020option add *StringDiffs.bodyFont {Courier -12} widgetDefault
     21option add *StringDiffs.bodyBackground white widgetDefault
    2122
    2223itcl::class Rappture::Tester::StringDiffs {
     
    6162            -diff 1->2 -layout inline
    6263    } {
     64        keep -foreground -cursor
     65        keep -addedbackground -addedforeground
     66        keep -deletedbackground -deletedforeground -overstrike
     67        keep -changedbackground -changedforeground
     68        rename -background -bodybackground bodyBackground Background
     69        rename -font -bodyfont bodyFont Font
     70    }
     71    $itk_component(scrl) contents $itk_component(body)
     72
     73    # viewer for side-by-side diffs
     74    itk_component add sidebyside {
     75        frame $itk_interior.sbys
     76    }
     77
     78    itk_component add title1 {
     79        label $itk_component(sidebyside).title1 -justify left -anchor w
     80    } {
     81        usual
     82        rename -font -titlefont titleFont Font
     83    }
     84    itk_component add body1 {
     85        Rappture::Diffview $itk_component(sidebyside).s1 \
     86            -highlightthickness 0 \
     87            -diff 2->1 -layout sidebyside
     88    } {
    6389        keep -background -foreground -cursor
    6490        keep -addedbackground -addedforeground
    6591        keep -deletedbackground -deletedforeground -overstrike
    6692        keep -changedbackground -changedforeground
     93        rename -background -bodybackground bodyBackground Background
    6794        rename -font -bodyfont bodyFont Font
    6895    }
    69     $itk_component(scrl) contents $itk_component(body)
    70 
    71     # viewer for side-by-side diffs
    72     itk_component add sidebyside {
    73         frame $itk_interior.sbys
    74     }
    75 
    76     itk_component add title1 {
    77         label $itk_component(sidebyside).title1 -justify left -anchor w
     96    itk_component add xsbar1 {
     97        scrollbar $itk_component(sidebyside).xsbar1 -orient horizontal \
     98            -command [list $itk_component(body1) xview]
     99    }
     100
     101    itk_component add title2 {
     102        label $itk_component(sidebyside).title2 -justify left -anchor w
    78103    } {
    79104        usual
    80105        rename -font -titlefont titleFont Font
    81106    }
    82     itk_component add body1 {
    83         Rappture::Diffview $itk_component(sidebyside).s1 \
     107    itk_component add body2 {
     108        Rappture::Diffview $itk_component(sidebyside).s2 \
    84109            -highlightthickness 0 \
    85110            -diff 1->2 -layout sidebyside
     
    89114        keep -deletedbackground -deletedforeground -overstrike
    90115        keep -changedbackground -changedforeground
    91         rename -font -bodyfont bodyFont Font
    92     }
    93     itk_component add xsbar1 {
    94         scrollbar $itk_component(sidebyside).xsbar1 -orient horizontal \
    95             -command [list $itk_component(body1) xview]
    96     }
    97 
    98     itk_component add title2 {
    99         label $itk_component(sidebyside).title2 -justify left -anchor w
    100     } {
    101         usual
    102         rename -font -titlefont titleFont Font
    103     }
    104     itk_component add body2 {
    105         Rappture::Diffview $itk_component(sidebyside).s2 \
    106             -highlightthickness 0 \
    107             -diff 2->1 -layout sidebyside
    108     } {
    109         keep -background -foreground -cursor
    110         keep -addedbackground -addedforeground
    111         keep -deletedbackground -deletedforeground -overstrike
    112         keep -changedbackground -changedforeground
     116        rename -background -bodybackground bodyBackground Background
    113117        rename -font -bodyfont bodyFont Font
    114118    }
     
    155159# ----------------------------------------------------------------------
    156160itcl::body Rappture::Tester::StringDiffs::show {v1 v2} {
     161    #
     162    # HACK ALERT!  The Diffview widget doesn't handle tabs at all.
     163    #   We'll convert all tabs to a few spaces until we get a chance
     164    #   to fix it properly.
     165    #
     166    set v1 [string map [list \t "   "] $v1]
     167    set v2 [string map [list \t "   "] $v2]
     168
    157169    #
    158170    # Figure out whether to show inline diffs or side-by-side.
  • trunk/tester/scripts/test.tcl

    r2136 r2139  
    2424    public method getResult {}
    2525    public method getTestInfo {args}
     26    public method getRunInfo {args}
    2627    public method getDiffs {args}
    2728
    28     public method getRunobj {}
    2929    public method getTestobj {}
    3030    public method getTestxml {}
    3131
    3232    public method run {args}
     33    public method abort {}
    3334    public method regoldenize {}
    3435
     
    4445    private method _setResult {name}
    4546    private method _computeDiffs {obj1 obj2 args}
     47    private method _buildFailure {str}
    4648
    4749    # use this to add tests to the "run" queue
     
    6062itcl::body Rappture::Tester::Test::constructor {toolobj testxml args} {
    6163    set _toolobj $toolobj
    62 
    6364    set _testxml $testxml
    6465    set _testobj [Rappture::library $testxml]
    65 
    66     # HACK: Add a new input to differentiate between results
    67     $_testobj put input.TestRun.current "Golden"
    6866
    6967    eval configure $args
     
    113111
    114112# ----------------------------------------------------------------------
     113# USAGE: getRunInfo <path>
     114# USAGE: getRunInfo children <path>
     115# USAGE: getRunInfo element ?-as type? <path>
     116#
     117# Returns info about the most recent run at the specified <path> in
     118# the XML.  If the <path> is missing or misspelled, this method returns
     119# "" instead of an error.
     120# ----------------------------------------------------------------------
     121itcl::body Rappture::Tester::Test::getRunInfo {args} {
     122    if {[llength $args] == 1} {
     123        set path [lindex $args 0]
     124        return [$_runobj get $path]
     125    }
     126    return [eval $_runobj $args]
     127}
     128
     129# ----------------------------------------------------------------------
    115130# USAGE: run ?-output callback path value path value ...?
    116131#
     
    132147    foreach path [Rappture::entities -as path $_testobj input] {
    133148        if {[$_testobj element -as type $path.current] ne ""} {
    134 puts "  override: $path = [$_testobj get $path.current]"
    135149            lappend args $path [$_testobj get $path.current]
    136150        }
     
    147161        } elseif {[Rappture::library isvalid $result]} {
    148162            set _runobj $result
    149             set idiffs [_computeDiffs [$_toolobj xml] $_testobj -in input]
    150             set odiffs [_computeDiffs $_testobj $_runobj -in output]
    151             set _diffs [concat $idiffs $odiffs]
    152 puts "DIFFS:"
    153 foreach rec $_diffs {
    154 puts ">> $rec"
    155 }
    156 
    157             # HACK: Add a new input to differentiate between results
    158             $_runobj put input.TestRun.current "Test result"
    159 
    160             # any differences from expected result mean test failed
    161             if {[llength $_diffs] == 0} {
     163
     164            if {[$_testobj get output.status] ne "ok"} {
     165                # expected test to fail, but it didn't
     166                set idiffs [_computeDiffs [$_toolobj xml] $_runobj -in input]
     167                set odiffs [_computeDiffs $_testobj $_runobj -what run]
     168                set _diffs [concat $idiffs $odiffs]
     169                _setResult "Fail"
     170            } else {
     171                set idiffs [_computeDiffs [$_toolobj xml] $_testobj -in input]
     172                set odiffs [_computeDiffs $_testobj $_runobj -in output]
     173                set _diffs [concat $idiffs $odiffs]
     174
     175                # any differences from expected result mean test failed
     176                if {[llength $_diffs] == 0} {
     177                    _setResult "Pass"
     178                } else {
     179                    _setResult "Fail"
     180                }
     181            }
     182            return "finished"
     183        } else {
     184            set _runobj [_buildFailure $result]
     185            if {[$_testobj get output.status] eq "failed"
     186                  && [$_testobj get output.log] eq $result} {
    162187                _setResult "Pass"
    163188            } else {
     189                set idiffs [_computeDiffs [$_toolobj xml] $_runobj -in input]
     190                set odiffs [_computeDiffs $_testobj $_runobj -what run]
     191                set _diffs [concat $idiffs $odiffs]
    164192                _setResult "Fail"
    165193            }
    166194            return "finished"
     195        }
     196    } else {
     197        set _runobj [_buildFailure $result]
     198        if {[$_testobj get output.status] eq "failed"
     199              && [$_testobj get output.log] eq $result} {
     200            _setResult "Pass"
    167201        } else {
     202            set idiffs [_computeDiffs [$_toolobj xml] $_runobj -in input]
     203            set odiffs [_computeDiffs $_testobj $_runobj -what run]
     204            set _diffs [concat $idiffs $odiffs]
    168205            _setResult "Fail"
    169             return "failed: $result"
    170         }
    171     } else {
    172         _setResult "Fail"
    173         tk_messageBox -icon error -message "Tool failed: $result"
     206        }
    174207        return "finished"
    175208    }
     209}
     210
     211# ----------------------------------------------------------------------
     212# USAGE: abort
     213#
     214# Causes the current test kicked off by the "run" method to be aborted.
     215# ----------------------------------------------------------------------
     216itcl::body Rappture::Tester::Test::abort {} {
     217    $_toolobj abort
    176218}
    177219
     
    234276    # otherwise, compare the golden test vs. the test result
    235277    return [_computeDiffs $_testobj $_runobj -in $path -detail max]
    236 }
    237 
    238 # -----------------------------------------------------------------------
    239 # USAGE: getRunobj
    240 #
    241 # Returns the library object generated by the previous run of the test.
    242 # Throws an error if the test has not been run.
    243 # -----------------------------------------------------------------------
    244 itcl::body Rappture::Tester::Test::getRunobj {} {
    245     if {$_runobj eq ""} {
    246         error "Test has not yet been run."
    247     }
    248     return $_runobj
    249278}
    250279
     
    300329# ----------------------------------------------------------------------
    301330# USAGE: _computeDiffs <xmlObj1> <xmlObj2> ?-in xxx? \
    302 #            ?-what value|attrs|all? ?-detail min|max?
     331#            ?-what value|attrs|run|all? ?-detail min|max?
    303332#
    304333# Used internally to compute differences between two different XML
     
    324353    Rappture::getopts args params {
    325354        value -in output
    326         value -what all
     355        value -what "attrs value"
    327356        value -detail min
    328357    }
    329358    if {$params(-what) == "all"} {
    330         set params(-what) "attrs value"
     359        set params(-what) "attrs value run"
     360    }
     361
     362    # handle any run output diffs first, so they appear at the top
     363    # report this as one incident -- not separate reports for status/log
     364    set rlist ""
     365    if {[lsearch $params(-what) "run"] >= 0} {
     366        set st1 [$obj1 get output.status]
     367        set st2 [$obj2 get output.status]
     368        if {$st1 ne $st2} {
     369            # status changes are most serious
     370            lappend rlist [list -what status -path output.status \
     371                -obj1 $obj1 -obj2 $obj2]
     372        } else {
     373            set log1 [$obj1 get output.log]
     374            set log2 [$obj2 get output.log]
     375            if {$log1 ne $log2} {
     376                # flag log changes instead if status agrees
     377                lappend rlist [list -what status -path output.log \
     378                    -obj1 $obj1 -obj2 $obj2]
     379            }
     380        }
    331381    }
    332382
    333383    # scan through the specified sections or paths
    334     set rlist ""
    335384    foreach elem $params(-in) {
    336385        if {[string first . $elem] >= 0} {
     
    359408                        lappend details -val1 $val1 -val2 $val2
    360409
    361 puts "COMPARE: $path $obj1 =?= $obj2"
    362 puts "  $val1 =?= $val2"
    363410                        if {$val1 eq "" || $val2 eq ""} {
    364411                            lappend rlist [linsert $details 0 -what "value c"]
     
    422469                        }
    423470                      }
     471                      run {
     472                        # do nothing -- already handled above
     473
     474                        # handled this comparison
     475                        set v2paths [lreplace $v2paths $i $i]
     476                      }
    424477                      default {
    425                         error "bad part \"$part\": should be attrs, value"
     478                        error "bad part \"$part\": should be attrs, value, run"
    426479                      }
    427480                    }
     
    437490    }
    438491    return $rlist
     492}
     493
     494# ----------------------------------------------------------------------
     495# USAGE: _buildFailure <output>
     496#
     497# Returns a new Rappture::library object that contains a copy of the
     498# original test with the given <output> and a failing status.  This
     499# is used to represent the result of a test that aborts without
     500# producing a valid run.xml file.
     501# ----------------------------------------------------------------------
     502itcl::body Rappture::Tester::Test::_buildFailure {output} {
     503    set info "<?xml version=\"1.0\"?>\n[$_testobj xml]"
     504    set obj [Rappture::LibraryObj ::#auto $info]
     505    $obj remove test
     506
     507    $obj put output.time [clock format [clock seconds]]
     508    $obj put output.status failed
     509    $obj put output.user $::tcl_platform(user)
     510    $obj put output.log $output
     511
     512    return $obj
    439513}
    440514
  • trunk/tester/scripts/testtree.tcl

    r2081 r2139  
    8585    $itk_component(treeview) column insert end test -hide yes
    8686    $itk_component(treeview) column configure treeView -justify left -title "Test Case"
     87    $itk_component(treeview) sort configure -mode dictionary -column treeView
     88    $itk_component(treeview) sort auto yes
     89
    8790    $itk_component(scrollbars) contents $itk_component(treeview)
    8891
     
    229232                default { set data(result) "" }
    230233            }
    231 puts "ICON: $data(result)"
    232234            $itk_component(treeview) entry configure $n -data [array get data]
    233235
Note: See TracChangeset for help on using the changeset viewer.