Changeset 2139

Timestamp:

Mar 18, 2011, 8:45:29 AM (14 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

Files:

• example/tests/test4a.xml (added)
• scripts/legend.tcl (added)
• scripts/main.tcl (modified) (12 diffs)
• scripts/objview.tcl (modified) (1 diff)
• scripts/runview.tcl (added)
• scripts/statuslist.tcl (modified) (1 diff)
• scripts/stringdiffs.tcl (modified) (4 diffs)
• scripts/test.tcl (modified) (12 diffs)
• scripts/testtree.tcl (modified) (2 diffs)

trunk/tester/scripts/main.tcl

@@ -44 +44 @@
 option add *Progress.barColor #ffffcc
 option add *Diffview.background white
+option add *Text.background white
 option add *Balloon.titleBackground #6666cc
 option add *Balloon.titleForeground white
@@ -133 +134 @@
 set xmlobj [Rappture::library $params(-tool)]
 set ToolObj [Rappture::Tool ::#auto $xmlobj $installdir]
+set DiffShow ""  ;# used to track which diff objects are being displayed
 
 # ----------------------------------------------------------------------
@@ -210 +212 @@
 
 # show add/deleted styles at the bottom
-frame .testdiffs.legend
+Rappture::Tester::Legend .testdiffs.legend
 pack .testdiffs.legend -side bottom -fill x
-frame .testdiffs.legend.line -height 1 -background black
-pack .testdiffs.legend.line -side top -fill x -pady {0 2}
-label .testdiffs.legend.lleg -text "Legend: "
-pack .testdiffs.legend.lleg -side left
-frame .testdiffs.legend.add -width 16 -height 16 -borderwidth 1 -relief solid
-pack .testdiffs.legend.add -side left -padx {6 0}
-label .testdiffs.legend.addl -text "= Added"
-pack .testdiffs.legend.addl -side left
-frame .testdiffs.legend.del -width 16 -height 16 -borderwidth 1 -relief solid
-pack .testdiffs.legend.del -side left -padx {10 0}
-label .testdiffs.legend.dell -text "= Deleted"
-pack .testdiffs.legend.dell -side left
+frame .testdiffs.line -height 1 -background black
+pack .testdiffs.line -side bottom -fill x -pady {0 2}
 
 # diff viewer goes in this spot
@@ -231 +223 @@
 # viewer for attribute diffs
 Rappture::Tester::ObjView .testdiffs.body.attrs
+
+# viewer for run status diffs
+Rappture::Tester::RunView .testdiffs.body.runs
 
 # viewer for value diffs where object is extra or missing
@@ -259 +254 @@
 pack .testdiffs.body.val2strs.diffs -expand yes -fill both -padx 10 -pady 10
 
+# viewer for value diffs where we have a special object viewer
+Rappture::Panes .testdiffs.body.val2objs -orientation horizontal -sashcursor sb_h_double_arrow
+
+# empty area for the object value viewer
+set win [.testdiffs.body.val2objs pane 0]
+frame $win.val
+pack $win.val -expand yes -fill both
+
+# show object details and diff on the right-hand side
+set win [.testdiffs.body.val2objs insert end -fraction 0.5]
+Rappture::Tester::ObjView $win.obj -details min -showdiffs no
+pack $win.obj -side top -fill x
+Rappture::Tester::StringDiffs $win.diffs \
+    -title1 "Expected this:" -title2 "Got this:"
+pack $win.diffs -expand yes -fill both -padx 4 -pady 4
+
 # plug the proper diff colors into the legend area
-.testdiffs.legend.add configure \
-    -background [.testdiffs.body.attrs cget -addedbackground]
-.testdiffs.legend.del configure \
-    -background [.testdiffs.body.attrs cget -deletedbackground]
+.testdiffs.legend insert end -title "= Added" -shape box \
+    -color [.testdiffs.body.val2strs.diffs cget -addedbackground]
+.testdiffs.legend insert end -title "= Deleted" -shape box \
+    -color [.testdiffs.body.val2strs.diffs cget -deletedbackground]
+.testdiffs.legend insert end -title "= Changed" -shape box \
+    -color [.testdiffs.body.val2strs.diffs cget -changedbackground]
+.testdiffs.legend insert end -title "= Test Result" -shape line \
+    -color red -anchor e
+.testdiffs.legend insert end -title "= Expected Result" -shape line \
+    -color black -anchor e
 
 # Load all tests in the test directory
@@ -400 +417 @@
                     }
                   }
+                  status {
+                    set icon [Rappture::icon fail16]
+                    set title "Run failure"
+                    if {$diff(-path) eq "output.status"} {
+                        set desc "Test run failure was not expected"
+                        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."
+                    } else {
+                        set desc "Test run failure produced different output"
+                        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."
+                    }
+                  }
                   default {
                     error "don't know how to handle difference \"$what\""
@@ -513 +541 @@
 # ----------------------------------------------------------------------
 proc tester_diff_show {args} {
-    global Viewers
+    global DiffShow
 
     set testtree [.pw pane 0].tree
     set rhs [.pw pane 1]
     set testview $rhs.testview
-
-    # show the test data in the header -- doesn't accept the -index, though
+    set viewarea [.testdiffs.body.val2objs pane 0].val
+
+    # clean up from the last call
+    set viewer [lindex $DiffShow 0]
+    if {$viewer ne ""} {
+        $viewer delete
+        foreach obj [lrange $DiffShow 1 end] {
+            itcl::delete object $obj
+        }
+    }
+    set DiffShow ""
+
+    # show the diff overview in the header
     array set data $args
-puts "SHOW: [array get data]"
     .testdiffs.hd.inner.title configure -image $data(-icon) -text $data(-body)
 
@@ -536 +574 @@
 
     switch -glob -- $diff(-what) {
-        "value +" {
+        "value *" {
+            foreach w [pack slaves $viewarea] {
+                pack forget $w
+            }
+
+            set op [lindex $diff(-what) 1]
+            set w .testdiffs.body.val1str.obj
+            switch -- $op {
+                +       { set bg [$w cget -addedbackground] }
+                -       { set bg [$w cget -deletedbackground] }
+                default { set bg [lindex [$w configure -background] 3] }
+            }
+
+            # get the first value in obj or string form
+            set val1 ""
+            if {[catch {Rappture::objects::import $diff(-obj1) $diff(-path)} val1] == 0 && $val1 ne ""} {
+                set viewer [Rappture::objects::viewer $val1 \
+                    -for output -parent $viewarea]
+                if {$viewer ne ""} {
+                    set DiffShow [list $viewer $val1]
+                }
+                # try to get a string rep too
+                set status [$val1 export string str]
+                if {[lindex $status 0]} { set vstr1 $str }
+            }
+
             # get a string rep for the second value
+            set val2 ""
             if {[catch {Rappture::objects::import $diff(-obj2) $diff(-path)} val2] == 0 && $val2 ne ""} {
+                set viewer [Rappture::objects::viewer $val2 \
+                    -for output -parent $viewarea]
+                if {$viewer ne ""} {
+                    if {$DiffShow ne ""} {
+                        if {[lindex $DiffShow 0] eq $viewer} {
+                            lappend DiffShow $val2
+                        } else {
+                            error "type mismatch between values: $diff(-obj1) vs $diff(-obj2) -- diff should have caught this as \"type\" difference"
+                        }
+                    } else {
+                        set DiffShow [list $viewer $val2]
+                    }
+                }
+                # try to get a string rep too
                 set status [$val2 export string str]
-                if {[lindex $status 0]} {
-                    set v2 $str
+                if {[lindex $status 0]} { set vstr2 $str }
+            }
+
+            if {$DiffShow ne ""} {
+                # we have a value viewer -- show the values in that
+                pack $viewer -expand yes -fill both
+
+                if {$val1 ne ""} {
+                    $viewer add $val1 [list -color black -description "Expected Result"]
                 }
-                itcl::delete object $val2
-            }
-
-            if {[info exists v2]} {
-                # we have a value -- show it
+                if {$val2 ne ""} {
+                    $viewer add $val2 [list -color red -description "Test Result"]
+                }
+
+                # show the string diffs too
+                set w [.testdiffs.body.val2objs pane 1]
+                $w.obj configure -background $bg \
+                    -testobj $diff(-testobj) -path $diff(-path)
+
+                if {[info exists vstr1]} { set v1 $vstr1 } else { set v1 "" }
+                if {[info exists vstr2]} { set v2 $vstr2 } else { set v2 "" }
+                $w.diffs show $v1 $v2
+
+                set win .testdiffs.body.val2objs
+
+                set legsettings [list 2 normal \
+                    3 [expr {($val2 ne "") ? "normal" : "disabled"}] \
+                    4 [expr {($val1 ne "") ? "normal" : "disabled"}]]
+
+            } elseif {[info exists vstr1] && [info exists vstr2]} {
+                # we have two value strings -- show as a diff
+                set win .testdiffs.body.val2strs
+                $win.obj configure -background $bg \
+                    -testobj $diff(-testobj) -path $diff(-path)
+                $win.diffs show $vstr1 $vstr2
+                set legsettings {2 normal 3 disabled 4 disabled}
+            } elseif {[info exists vstr1] || [info exists vstr2]} {
+                # we have one value string -- show it
+                if {[info exists vstr1]} {
+                    set val $vstr1
+                } else {
+                    set val $vstr2
+                }
                 set win .testdiffs.body.val1str
-                set bg [$win.obj cget -addedbackground]
                 $win.obj configure -background $bg \
                     -testobj $diff(-testobj) -path $diff(-path)
                 $win.scrl.text configure -state normal
                 $win.scrl.text delete 1.0 end
-                $win.scrl.text insert end $v2
-                $win.scrl.text configure -state disabled -background $bg
+                $win.scrl.text insert end $val
+                $win.scrl.text configure -state disabled
+                set legsettings {2 disabled 3 disabled 4 disabled}
             } else {
                 # don't have a value -- show the attributes
                 set win .testdiffs.body.val
-                set bg [$win.obj cget -addedbackground]
                 $win.obj configure -background $bg \
                     -testobj $diff(-testobj) -path $diff(-path)
-            }
-        }
-        "value -" {
-            # get a string rep for the first value
-            if {[catch {Rappture::objects::import $diff(-obj1) $diff(-path)} val1] == 0 && $val1 ne ""} {
-                set status [$val1 export string str]
-                if {[lindex $status 0]} {
-                    set v1 $str
-                }
+                set legsettings {2 disabled 3 disabled 4 disabled}
+            }
+
+            # clean up any objects that are not being stored
+            if {$val1 ne "" && [lsearch $DiffShow $val1] < 0} {
                 itcl::delete object $val1
             }
-
-            if {[info exists v1]} {
-                # we have a value -- show it
-                set win .testdiffs.body.val1str
-                set bg [$win.obj cget -deletedbackground]
-                $win.obj configure -background $bg \
-                    -testobj $diff(-testobj) -path $diff(-path)
-                $win.scrl.text configure -state normal
-                $win.scrl.text delete 1.0 end
-                $win.scrl.text insert end $v1
-                $win.scrl.text configure -state disabled -background $bg
-            } else {
-                # don't have a value -- show the attributes
-                set win .testdiffs.body.val
-                set bg [$win.obj cget -deletedbackground]
-                $win.obj configure -background $bg \
-                    -testobj $diff(-testobj) -path $diff(-path)
-            }
-        }
-        "value c" {
-            set win .testdiffs.body.val2strs
-            set bg [lindex [$win.obj configure -background] 3]
-            
-            $win.obj configure -background $bg \
-                -testobj $diff(-testobj) -path $diff(-path)
-
-            # get a string rep for the first value
-            set v1 "???"
-            if {[catch {Rappture::objects::import $diff(-obj1) $diff(-path)} val1] == 0 && $val1 ne ""} {
-                set status [$val1 export string str]
-                if {[lindex $status 0]} {
-                    set v1 $str
-                }
-                itcl::delete object $val1
-            }
-
-            # get a string rep for the second value
-            set v2 "???"
-            if {[catch {Rappture::objects::import $diff(-obj2) $diff(-path)} val2] == 0 && $val2 ne ""} {
-                set status [$val2 export string str]
-                if {[lindex $status 0]} {
-                    set v2 $str
-                }
+            if {$val2 ne "" && [lsearch $DiffShow $val2] < 0} {
                 itcl::delete object $val2
             }
-
-            $win.diffs show $v1 $v2
         }
         "attrs *" {
@@ -626 +690 @@
             $win configure -testobj $diff(-testobj) -background $bg \
                 -path $diff(-path) -details max -showdiffs yes
+            set legsettings {2 disabled 3 disabled 4 disabled}
+        }
+        "status" {
+            set win .testdiffs.body.runs
+            $win configure -testobj $diff(-testobj) -showdiffs yes
+            set legsettings {2 disabled 3 disabled 4 disabled}
         }
         "type *" {
             error "don't know how to show type diffs"
+            set legsettings {2 disabled 3 disabled 4 disabled}
         }
     }
@@ -636 +707 @@
         }
         pack $win -expand yes -fill both
+    }
+
+    # fix up the legend to best explain the current result
+    foreach {index state} $legsettings {
+        .testdiffs.legend itemconfigure $index -state $state
     }
 
@@ -662 +738 @@
 proc tester_regoldenize {} {
     set testtree [.pw pane 0].tree
-    set tests [$testtree curselection]
-
-    if {[llength $tests] != 1} {
-        error "Cannot regoldenize. One test must be selected"
-    }
-
-    set test [lindex $tests 0]
+    set seltests [$testtree curselection]
+
+    if {[llength $seltests] != 1} {
+        error "Oops! Multiple tests selected to regoldenize.  How did we get here?"
+    }
+
+    set test [lindex $seltests 0]
     set testxml [$test getTestxml]
     if {[tk_messageBox -type yesno -icon warning -message "Are you sure you want to regoldenize?\n$testxml will be overwritten."]} {
@@ -677 +753 @@
     }
 }
-
-# ----------------------------------------------------------------------
-# USAGE: tester_view_outputs
-#
-# Displays the outputs of the currently selected test case as they would
-# be seen when running the tool normally.  If the test has completed
-# with no error, then show the new outputs alongside the golden results.
-# ----------------------------------------------------------------------
-proc tester_view_outputs {} {
-    set testtree [.pw pane 0].tree
-    set rhs [.pw pane 1]
-    set resultspage $rhs.testoutput.rp
-    set tests [$testtree curselection]
-
-    if {[llength $tests] != 1} {
-        error "Cannot display outputs. One test must be selected"
-    }
-
-    # Unpack right hand side
-    foreach win [pack slaves $rhs] {
-        pack forget $win
-    }
-
-    # Clear any previously loaded outputs from the resultspage
-    $resultspage clear -nodelete
-
-    # Display testobj, and runobj if test has completed successfully
-    set test [lindex $tests 0]
-    $resultspage load [$test getTestobj]
-    set result [$test getResult]
-    if {$result ne "?" && $result ne "Error"} {
-        $resultspage load [$test getRunobj]
-    }
-
-    pack $rhs.testoutput -expand yes -fill both -padx 8 -pady 8
-}
-

trunk/tester/scripts/objview.tcl

@@ -104 +104 @@
     if {$testobj ne "" && $path ne ""} {
         set type [$testobj getTestInfo element -as type $path]
+        if {$type eq ""} {
+            set type [$testobj getRunInfo element -as type $path]
+        }
     }
 

trunk/tester/scripts/statuslist.tcl

@@ -50 +50 @@
     public method size {} { return [llength $_entries] }
     public method get {pos args}
-    public method invoke {{index "current"}}
     public method view {{index "current"}}
 

trunk/tester/scripts/stringdiffs.tcl

@@ -19 +19 @@
 option add *StringDiffs.titleFont {Arial -12 bold} widgetDefault
 option add *StringDiffs.bodyFont {Courier -12} widgetDefault
+option add *StringDiffs.bodyBackground white widgetDefault
 
 itcl::class Rappture::Tester::StringDiffs {
@@ -61 +62 @@
             -diff 1->2 -layout inline
     } {
+        keep -foreground -cursor
+        keep -addedbackground -addedforeground
+        keep -deletedbackground -deletedforeground -overstrike
+        keep -changedbackground -changedforeground
+        rename -background -bodybackground bodyBackground Background
+        rename -font -bodyfont bodyFont Font
+    }
+    $itk_component(scrl) contents $itk_component(body)
+
+    # viewer for side-by-side diffs
+    itk_component add sidebyside {
+        frame $itk_interior.sbys
+    }
+
+    itk_component add title1 {
+        label $itk_component(sidebyside).title1 -justify left -anchor w
+    } {
+        usual
+        rename -font -titlefont titleFont Font
+    }
+    itk_component add body1 {
+        Rappture::Diffview $itk_component(sidebyside).s1 \
+            -highlightthickness 0 \
+            -diff 2->1 -layout sidebyside
+    } {
         keep -background -foreground -cursor
         keep -addedbackground -addedforeground
         keep -deletedbackground -deletedforeground -overstrike
         keep -changedbackground -changedforeground
+        rename -background -bodybackground bodyBackground Background
         rename -font -bodyfont bodyFont Font
     }
-    $itk_component(scrl) contents $itk_component(body)
-
-    # viewer for side-by-side diffs
-    itk_component add sidebyside {
-        frame $itk_interior.sbys
-    }
-
-    itk_component add title1 {
-        label $itk_component(sidebyside).title1 -justify left -anchor w
+    itk_component add xsbar1 {
+        scrollbar $itk_component(sidebyside).xsbar1 -orient horizontal \
+            -command [list $itk_component(body1) xview]
+    }
+
+    itk_component add title2 {
+        label $itk_component(sidebyside).title2 -justify left -anchor w
     } {
         usual
         rename -font -titlefont titleFont Font
     }
-    itk_component add body1 {
-        Rappture::Diffview $itk_component(sidebyside).s1 \
+    itk_component add body2 {
+        Rappture::Diffview $itk_component(sidebyside).s2 \
             -highlightthickness 0 \
             -diff 1->2 -layout sidebyside
@@ -89 +114 @@
         keep -deletedbackground -deletedforeground -overstrike
         keep -changedbackground -changedforeground
-        rename -font -bodyfont bodyFont Font
-    }
-    itk_component add xsbar1 {
-        scrollbar $itk_component(sidebyside).xsbar1 -orient horizontal \
-            -command [list $itk_component(body1) xview]
-    }
-
-    itk_component add title2 {
-        label $itk_component(sidebyside).title2 -justify left -anchor w
-    } {
-        usual
-        rename -font -titlefont titleFont Font
-    }
-    itk_component add body2 {
-        Rappture::Diffview $itk_component(sidebyside).s2 \
-            -highlightthickness 0 \
-            -diff 2->1 -layout sidebyside
-    } {
-        keep -background -foreground -cursor
-        keep -addedbackground -addedforeground
-        keep -deletedbackground -deletedforeground -overstrike
-        keep -changedbackground -changedforeground
+        rename -background -bodybackground bodyBackground Background
         rename -font -bodyfont bodyFont Font
     }
@@ -155 +159 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::Tester::StringDiffs::show {v1 v2} {
+    #
+    # HACK ALERT!  The Diffview widget doesn't handle tabs at all.
+    #   We'll convert all tabs to a few spaces until we get a chance
+    #   to fix it properly.
+    #
+    set v1 [string map [list \t "   "] $v1]
+    set v2 [string map [list \t "   "] $v2]
+
     #
     # Figure out whether to show inline diffs or side-by-side.

trunk/tester/scripts/test.tcl

@@ -24 +24 @@
     public method getResult {}
     public method getTestInfo {args}
+    public method getRunInfo {args}
     public method getDiffs {args}
 
-    public method getRunobj {}
     public method getTestobj {}
     public method getTestxml {}
 
     public method run {args}
+    public method abort {}
     public method regoldenize {}
 
@@ -44 +45 @@
     private method _setResult {name}
     private method _computeDiffs {obj1 obj2 args}
+    private method _buildFailure {str}
 
     # use this to add tests to the "run" queue
@@ -60 +62 @@
 itcl::body Rappture::Tester::Test::constructor {toolobj testxml args} {
     set _toolobj $toolobj
-
     set _testxml $testxml
     set _testobj [Rappture::library $testxml]
-
-    # HACK: Add a new input to differentiate between results
-    $_testobj put input.TestRun.current "Golden"
 
     eval configure $args
@@ -113 +111 @@
 
 # ----------------------------------------------------------------------
+# USAGE: getRunInfo <path>
+# USAGE: getRunInfo children <path>
+# USAGE: getRunInfo element ?-as type? <path>
+# 
+# Returns info about the most recent run at the specified <path> in
+# the XML.  If the <path> is missing or misspelled, this method returns
+# "" instead of an error.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Tester::Test::getRunInfo {args} {
+    if {[llength $args] == 1} {
+        set path [lindex $args 0]
+        return [$_runobj get $path]
+    }
+    return [eval $_runobj $args]
+}
+
+# ----------------------------------------------------------------------
 # USAGE: run ?-output callback path value path value ...?
 #
@@ -132 +147 @@
     foreach path [Rappture::entities -as path $_testobj input] {
         if {[$_testobj element -as type $path.current] ne ""} {
-puts "  override: $path = [$_testobj get $path.current]"
             lappend args $path [$_testobj get $path.current]
         }
@@ -147 +161 @@
         } elseif {[Rappture::library isvalid $result]} {
             set _runobj $result
-            set idiffs [_computeDiffs [$_toolobj xml] $_testobj -in input]
-            set odiffs [_computeDiffs $_testobj $_runobj -in output]
-            set _diffs [concat $idiffs $odiffs]
-puts "DIFFS:"
-foreach rec $_diffs {
-puts ">> $rec"
-}
-
-            # HACK: Add a new input to differentiate between results
-            $_runobj put input.TestRun.current "Test result"
-
-            # any differences from expected result mean test failed
-            if {[llength $_diffs] == 0} {
+
+            if {[$_testobj get output.status] ne "ok"} {
+                # expected test to fail, but it didn't
+                set idiffs [_computeDiffs [$_toolobj xml] $_runobj -in input]
+                set odiffs [_computeDiffs $_testobj $_runobj -what run]
+                set _diffs [concat $idiffs $odiffs]
+                _setResult "Fail"
+            } else {
+                set idiffs [_computeDiffs [$_toolobj xml] $_testobj -in input]
+                set odiffs [_computeDiffs $_testobj $_runobj -in output]
+                set _diffs [concat $idiffs $odiffs]
+
+                # any differences from expected result mean test failed
+                if {[llength $_diffs] == 0} {
+                    _setResult "Pass"
+                } else {
+                    _setResult "Fail"
+                }
+            }
+            return "finished"
+        } else {
+            set _runobj [_buildFailure $result]
+            if {[$_testobj get output.status] eq "failed"
+                  && [$_testobj get output.log] eq $result} {
                 _setResult "Pass"
             } else {
+                set idiffs [_computeDiffs [$_toolobj xml] $_runobj -in input]
+                set odiffs [_computeDiffs $_testobj $_runobj -what run]
+                set _diffs [concat $idiffs $odiffs]
                 _setResult "Fail"
             }
             return "finished"
+        }
+    } else {
+        set _runobj [_buildFailure $result]
+        if {[$_testobj get output.status] eq "failed"
+              && [$_testobj get output.log] eq $result} {
+            _setResult "Pass"
         } else {
+            set idiffs [_computeDiffs [$_toolobj xml] $_runobj -in input]
+            set odiffs [_computeDiffs $_testobj $_runobj -what run]
+            set _diffs [concat $idiffs $odiffs]
             _setResult "Fail"
-            return "failed: $result"
-        }
-    } else {
-        _setResult "Fail"
-        tk_messageBox -icon error -message "Tool failed: $result"
+        }
         return "finished"
     }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: abort
+#
+# Causes the current test kicked off by the "run" method to be aborted.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Tester::Test::abort {} {
+    $_toolobj abort
 }
 
@@ -234 +276 @@
     # otherwise, compare the golden test vs. the test result
     return [_computeDiffs $_testobj $_runobj -in $path -detail max]
-}
-
-# -----------------------------------------------------------------------
-# USAGE: getRunobj
-#
-# Returns the library object generated by the previous run of the test.
-# Throws an error if the test has not been run.
-# -----------------------------------------------------------------------
-itcl::body Rappture::Tester::Test::getRunobj {} {
-    if {$_runobj eq ""} {
-        error "Test has not yet been run."
-    }
-    return $_runobj
 }
 
@@ -300 +329 @@
 # ----------------------------------------------------------------------
 # USAGE: _computeDiffs <xmlObj1> <xmlObj2> ?-in xxx? \
-#            ?-what value|attrs|all? ?-detail min|max?
+#            ?-what value|attrs|run|all? ?-detail min|max?
 #
 # Used internally to compute differences between two different XML
@@ -324 +353 @@
     Rappture::getopts args params {
         value -in output
-        value -what all
+        value -what "attrs value"
         value -detail min
     }
     if {$params(-what) == "all"} {
-        set params(-what) "attrs value"
+        set params(-what) "attrs value run"
+    }
+
+    # handle any run output diffs first, so they appear at the top
+    # report this as one incident -- not separate reports for status/log
+    set rlist ""
+    if {[lsearch $params(-what) "run"] >= 0} {
+        set st1 [$obj1 get output.status]
+        set st2 [$obj2 get output.status]
+        if {$st1 ne $st2} {
+            # status changes are most serious
+            lappend rlist [list -what status -path output.status \
+                -obj1 $obj1 -obj2 $obj2]
+        } else {
+            set log1 [$obj1 get output.log]
+            set log2 [$obj2 get output.log]
+            if {$log1 ne $log2} {
+                # flag log changes instead if status agrees
+                lappend rlist [list -what status -path output.log \
+                    -obj1 $obj1 -obj2 $obj2]
+            }
+        }
     }
 
     # scan through the specified sections or paths
-    set rlist ""
     foreach elem $params(-in) {
         if {[string first . $elem] >= 0} {
@@ -359 +408 @@
                         lappend details -val1 $val1 -val2 $val2
 
-puts "COMPARE: $path $obj1 =?= $obj2"
-puts "  $val1 =?= $val2"
                         if {$val1 eq "" || $val2 eq ""} {
                             lappend rlist [linsert $details 0 -what "value c"]
@@ -422 +469 @@
                         }
                       }
+                      run {
+                        # do nothing -- already handled above
+
+                        # handled this comparison
+                        set v2paths [lreplace $v2paths $i $i]
+                      }
                       default {
-                        error "bad part \"$part\": should be attrs, value"
+                        error "bad part \"$part\": should be attrs, value, run"
                       }
                     }
@@ -437 +490 @@
     }
     return $rlist
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _buildFailure <output>
+#
+# Returns a new Rappture::library object that contains a copy of the
+# original test with the given <output> and a failing status.  This
+# is used to represent the result of a test that aborts without
+# producing a valid run.xml file.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Tester::Test::_buildFailure {output} {
+    set info "<?xml version=\"1.0\"?>\n[$_testobj xml]"
+    set obj [Rappture::LibraryObj ::#auto $info]
+    $obj remove test
+
+    $obj put output.time [clock format [clock seconds]]
+    $obj put output.status failed
+    $obj put output.user $::tcl_platform(user)
+    $obj put output.log $output
+
+    return $obj
 }
 

trunk/tester/scripts/testtree.tcl

@@ -85 +85 @@
     $itk_component(treeview) column insert end test -hide yes
     $itk_component(treeview) column configure treeView -justify left -title "Test Case"
+    $itk_component(treeview) sort configure -mode dictionary -column treeView
+    $itk_component(treeview) sort auto yes
+
     $itk_component(scrollbars) contents $itk_component(treeview)
 
@@ -229 +232 @@
                 default { set data(result) "" }
             }
-puts "ICON: $data(result)"
             $itk_component(treeview) entry configure $n -data [array get data]