source: trunk/tester/scripts/main.tcl @ 4503

Last change on this file since 4503 was 4127, checked in by mmc, 10 years ago

Added a "-auto" option to "rappture -tester" so you can run all tests
without the GUI in the background. This is needed as we try to run
regressions automatically during the contribtool process. In order to
do this, I had to split the Tool object into a "Task" that can run
without the GUI, and the "Tool" that acts as a ControlOwner?. I also
had to support for resource file processing into the generic Rappture
package. As a result, "rappture -tester -auto" can run without an
X window connection.

Added support for "job_protocol mx" in the resources file. If you
specify this, then Rappture will execute "mx cmd arg arg..." to run
each job.

  • Property svn:executable set to *
File size: 34.2 KB
Line 
1#! /bin/sh
2# ----------------------------------------------------------------------
3#  RAPPTURE REGRESSION TESTER
4#
5#  This program will read a set of test xml files typically located in
6#  a tool's "tests" subdirectory, and provide an interactive test suite.
7#  The test xml files should contain a complete set of inputs and
8#  outputs for one run of an application.  In each test xml, a label
9#  must be located at the path test.label.  Test labels may be organized
10#  hierarchically by using dots to separate components of the test label
11#  (example: roomtemp.1eV).  A description may optionally be located at
12#  the path test.description.  Input arguments are the path to the
13#  tool.xml of the version being tested, and the path the the directory
14#  containing a set of test xml files.  If the arguments are missing,
15#  the program will attempt to locate them automatically.
16#
17#  USAGE: tester.tcl ?-tool tool.xml? ?-testdir tests?
18# ======================================================================
19#  AUTHORS:  Michael McLennan, Ben Rafferty, Purdue University
20#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
21#
22#  See the file "license.terms" for information on usage and
23#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
24# ======================================================================
25#\
26exec tclsh "$0" $*
27# ----------------------------------------------------------------------
28# wish executes everything from here on...
29
30# take the main window down for now, so we can avoid a flash on the screen
31wm withdraw .
32
33set testerdir [file dirname [file normalize [info script]]]
34lappend auto_path $testerdir
35
36package require Itk
37package require Img
38package require Rappture
39package require RapptureGUI
40
41option add *selectBackground #bfefff
42option add *Tooltip.background white
43option add *Editor.background white
44option add *Gauge.textBackground white
45option add *TemperatureGauge.textBackground white
46option add *Switch.textBackground white
47option add *Progress.barColor #ffffcc
48option add *Diffview.background white
49option add *Text.background white
50option add *Balloon.titleBackground #6666cc
51option add *Balloon.titleForeground white
52option add *Balloon*Label.font -*-helvetica-medium-r-normal-*-12-*
53option add *Balloon*Radiobutton.font -*-helvetica-medium-r-normal-*-12-*
54option add *Balloon*Checkbutton.font -*-helvetica-medium-r-normal-*-12-*
55option add *ResultSet.controlbarBackground #6666cc
56option add *ResultSet.controlbarForeground white
57option add *ResultSet.activeControlBackground #ccccff
58option add *ResultSet.activeControlForeground black
59option add *Radiodial.length 3i
60option add *BugReport*banner*foreground white
61option add *BugReport*banner*background #a9a9a9
62option add *BugReport*banner*highlightBackground #a9a9a9
63option add *BugReport*banner*font -*-helvetica-bold-r-normal-*-18-*
64
65option add *testdiffs.hd*background #666666
66option add *testdiffs.hd*highlightBackground #666666
67option add *testdiffs.hd*foreground white
68option add *testdiffs.hd.inner.highlightBackground #999999
69option add *testdiffs.hd.inner*font {Arial -12 bold}
70option add *testdiffs.hd.inner*help.font {Arial -10 italic}
71option add *testdiffs.hd.inner*help.padX 2
72option add *testdiffs.hd.inner*help.padY 2
73option add *testdiffs.hd.inner*help.borderWidth 1
74option add *testdiffs.hd.inner*help.relief flat
75option add *testdiffs.hd.inner*help.overRelief raised
76option add *testdiffs.legend*font {Arial -12}
77
78switch $tcl_platform(platform) {
79    unix - windows {
80        event add <<PopupMenu>> <ButtonPress-3>
81    }
82    macintosh {
83        event add <<PopupMenu>> <Control-ButtonPress-1>
84    }
85}
86
87# install a better bug handler
88Rappture::bugreport::install
89
90# fix the "grab" command to support a stack of grab windows
91Rappture::grab::init
92
93# bring in the Rappture object system
94Rappture::objects::init
95
96# add the local image directory onto the path
97Rappture::icon foo  ;# forces auto-loading of Rappture::icon
98set Rappture::icon::iconpath [linsert $Rappture::icon::iconpath 0 [file join $testerdir images]]
99
100
101Rappture::getopts argv params {
102    value -tool ""
103    value -testdir ""
104}
105
106# If tool.xml and test directory locations are not given, try to find them.
107if {$params(-tool) == ""} {
108    if {[file isfile tool.xml]} {
109        set params(-tool) tool.xml
110    } elseif {[file isfile [file join rappture tool.xml]]} {
111        set params(-tool) [file join rappture tool.xml]
112    } else {
113        puts "Cannot find tool.xml"
114        exit 1
115    }
116} elseif {![file isfile $params(-tool)]} {
117    puts "Tool \"$params(-tool)\" does not exist"
118    exit 1
119}
120
121if {$params(-testdir) == ""} {
122    set tooldir [file dirname $params(-tool)]
123    if {[file isdirectory [file join $tooldir tests]]} {
124        set params(-testdir) [file join $tooldir tests]
125    } elseif {[file isdirectory [file join [file dirname $tooldir] tests]]} {
126        set params(-testdir) [file join [file dirname $tooldir] tests]
127    } else {
128        puts "Cannot find test directory"
129        exit 1
130    }
131} elseif {![file isdirectory $params(-testdir)]} {
132    puts "Test directory \"$params(-testdir)\" does not exist"
133    exit 1
134}
135
136set installdir [file dirname [file normalize $params(-tool)]]
137set xmlobj [Rappture::library $params(-tool)]
138set TaskObj [Rappture::Task ::#auto $xmlobj $installdir]
139
140# tasks in the tester run quietly and discard results
141$TaskObj configure -jobstats "" -resultdir ""
142
143set DiffShow ""  ;# used to track which diff objects are being displayed
144
145# ----------------------------------------------------------------------
146# INITIALIZE WINDOW
147# ----------------------------------------------------------------------
148wm title . "Rappture Regression Tester"
149wm geometry . 800x500
150Rappture::Panes .pw -orientation horizontal -sashcursor sb_h_double_arrow
151pack .pw -expand yes -fill both
152
153set win [.pw pane 0]
154Rappture::Tester::TestTree $win.tree \
155    -selectcommand tester_selection_changed
156pack $win.tree -expand yes -fill both -padx 8 -pady 8
157
158set win [.pw insert end -fraction 0.8]
159
160# Frame for viewing tests
161# ----------------------------------------------------------------------
162frame $win.testview
163frame $win.testview.bbar
164pack $win.testview.bbar -side bottom -fill x -pady {8 0}
165button $win.testview.bbar.regoldenize -text "<< New golden standard" \
166    -state disabled -command tester_regoldenize
167pack $win.testview.bbar.regoldenize -side left
168Rappture::Tooltip::for $win.testview.bbar.regoldenize \
169    "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."
170
171pack $win.testview.bbar -side bottom -fill x
172
173Rappture::Tester::TestView $win.testview.overview \
174    -runcommand tester_run
175pack $win.testview.overview -side top -fill both -padx 8 -pady 8
176
177frame $win.testview.details
178label $win.testview.details.heading -text "Differences:"
179pack $win.testview.details.heading -side top -anchor w
180Rappture::Scroller $win.testview.details.scrl \
181    -xscrollmode auto -yscrollmode auto
182pack $win.testview.details.scrl -expand yes -fill both
183Rappture::Tester::StatusList $win.testview.details.scrl.list \
184    -viewcommand tester_diff_show
185$win.testview.details.scrl contents $win.testview.details.scrl.list
186
187# Frame for viewing running tests
188# ----------------------------------------------------------------------
189frame $win.testrun
190label $win.testrun.title -text "Output from test run:" -anchor w
191pack $win.testrun.title -side top -anchor w
192
193Rappture::Progress $win.testrun.progress
194button $win.testrun.abort -text "Abort"
195pack $win.testrun.abort -side bottom -pady {8 0}
196
197Rappture::Scroller $win.testrun.scrl -xscrollmode auto -yscrollmode auto
198pack $win.testrun.scrl -expand yes -fill both
199text $win.testrun.scrl.info -width 1 -height 1 -wrap none
200$win.testrun.scrl contents $win.testrun.scrl.info
201
202# Frame for viewing diffs
203# ---------------------------------------------------------------------
204frame .testdiffs -borderwidth 10 -relief flat
205
206# header at the top with info about the diff, help, and close button
207frame .testdiffs.hd -borderwidth 4 -relief flat
208pack .testdiffs.hd -side top -fill x
209frame .testdiffs.hd.inner -highlightthickness 1 -borderwidth 2 -relief flat
210pack .testdiffs.hd.inner -expand yes -fill both
211button .testdiffs.hd.inner.close -relief flat -overrelief raised \
212    -bitmap [Rappture::icon dismiss] -command tester_diff_hide
213pack .testdiffs.hd.inner.close -side right -padx 8
214label .testdiffs.hd.inner.title -compound left -anchor w -padx 8
215pack .testdiffs.hd.inner.title -side left
216button .testdiffs.hd.inner.help -anchor w -text "Help..." \
217    -command "::Rappture::Tooltip::tooltip show .testdiffs.hd.inner.help +10,0"
218pack .testdiffs.hd.inner.help -side left -padx 10
219
220# show add/deleted styles at the bottom
221Rappture::Tester::Legend .testdiffs.legend
222pack .testdiffs.legend -side bottom -fill x
223frame .testdiffs.line -height 1 -background black
224pack .testdiffs.line -side bottom -fill x -pady {0 2}
225
226# diff viewer goes in this spot
227frame .testdiffs.body
228pack .testdiffs.body -expand yes -fill both -padx 10 -pady {20 10}
229
230# viewer for attribute diffs
231Rappture::Tester::ObjView .testdiffs.body.attrs
232
233# viewer for run status diffs
234Rappture::Tester::RunView .testdiffs.body.runs
235
236# viewer for value diffs where object is extra or missing
237frame .testdiffs.body.val
238Rappture::Tester::ObjView .testdiffs.body.val.obj -details max -showdiffs no
239pack .testdiffs.body.val.obj -expand yes -fill both
240
241# viewer for value diffs where we have just one string
242frame .testdiffs.body.val1str
243Rappture::Tester::ObjView .testdiffs.body.val1str.obj \
244    -details min -showdiffs no
245pack .testdiffs.body.val1str.obj -side top -fill x
246label .testdiffs.body.val1str.l -text "Value:"
247pack .testdiffs.body.val1str.l -anchor w -padx 10 -pady {10 0}
248Rappture::Scroller .testdiffs.body.val1str.scrl \
249    -xscrollmode auto -yscrollmode auto
250pack .testdiffs.body.val1str.scrl -expand yes -fill both -padx 10 -pady {0 10}
251text .testdiffs.body.val1str.scrl.text -width 10 -height 1 -wrap char
252.testdiffs.body.val1str.scrl contents .testdiffs.body.val1str.scrl.text
253
254# viewer for value diffs where we have two strings but no special viewers
255frame .testdiffs.body.val2strs
256Rappture::Tester::ObjView .testdiffs.body.val2strs.obj \
257    -details min -showdiffs no
258pack .testdiffs.body.val2strs.obj -side top -fill x
259Rappture::Tester::StringDiffs .testdiffs.body.val2strs.diffs \
260    -title1 "Expected this:" -title2 "Got this:"
261pack .testdiffs.body.val2strs.diffs -expand yes -fill both -padx 10 -pady 10
262
263# viewer for value diffs where we have a special object viewer
264Rappture::Panes .testdiffs.body.val2objs -orientation horizontal -sashcursor sb_h_double_arrow
265
266# empty area for the object value viewer
267set win [.testdiffs.body.val2objs pane 0]
268frame $win.val
269pack $win.val -expand yes -fill both
270
271# show object details and diff on the right-hand side
272set win [.testdiffs.body.val2objs insert end -fraction 0.5]
273Rappture::Tester::ObjView $win.obj -details min -showdiffs no
274pack $win.obj -side top -fill x
275Rappture::Tester::StringDiffs $win.diffs \
276    -title1 "Expected this:" -title2 "Got this:"
277pack $win.diffs -expand yes -fill both -padx 4 -pady 4
278
279# viewer for showing string info if all else fails (e.g. unkobj errors)
280Rappture::Scroller .testdiffs.body.info \
281    -xscrollmode auto -yscrollmode auto
282pack .testdiffs.body.info -expand yes -fill both -padx 10 -pady {0 10}
283text .testdiffs.body.info.text -width 10 -height 1 -wrap char
284.testdiffs.body.info contents .testdiffs.body.info.text
285
286# plug the proper diff colors into the legend area
287.testdiffs.legend insert end -title "= Added" -shape box \
288    -color [.testdiffs.body.val2strs.diffs cget -addedbackground]
289.testdiffs.legend insert end -title "= Deleted" -shape box \
290    -color [.testdiffs.body.val2strs.diffs cget -deletedbackground]
291.testdiffs.legend insert end -title "= Changed" -shape box \
292    -color [.testdiffs.body.val2strs.diffs cget -changedbackground]
293.testdiffs.legend insert end -title "= Test Result" -shape line \
294    -color red -anchor e
295.testdiffs.legend insert end -title "= Expected Result" -shape line \
296    -color black -anchor e
297
298# Load all tests in the test directory
299# ----------------------------------------------------------------------
300set testtree [.pw pane 0].tree
301foreach file [glob -nocomplain -directory $params(-testdir) *.xml] {
302    set testobj [Rappture::Tester::Test ::#auto $TaskObj $file]
303    if {[$testobj getTestInfo test.label] eq ""} {
304        puts stderr "ERROR:  Missing test label in $file"
305        puts stderr "        skipping that test..."
306    } elseif {[catch {$testtree add $testobj} err]} {
307        puts stderr "ERROR:  Can't load test $file"
308        puts stderr "        $err"
309        puts stderr "        skipping that test..."
310    }
311}
312$testtree component treeview open -recurse root
313
314# ----------------------------------------------------------------------
315# USAGE: tester_selection_changed
316#
317# Invoked automatically whenever the selection changes in the tree
318# on the left.  Brings up a description of one or more selected tests
319# on the right-hand side.
320# ----------------------------------------------------------------------
321proc tester_selection_changed {args} {
322    set testtree [.pw pane 0].tree
323    set rhs [.pw pane 1]
324    set testview $rhs.testview
325    set tests [$testtree curselection]
326
327    # figure out what we should be showing on the right-hand side
328    if {[llength $tests] > 0} {
329        set status "?"
330        foreach obj $tests {
331            if {[$obj getResult] == "Running"} {
332                set status "Running"
333            }
334        }
335        if {$status == "Running"} {
336            set detailwidget $rhs.testrun
337        } else {
338            set detailwidget $rhs.testview
339        }
340    } else {
341        set detailwidget ""
342    }
343
344    # repack the right-hand side, if necessary
345    if {$detailwidget ne [pack slaves $rhs]} {
346        foreach win [pack slaves $rhs] {
347            pack forget $win
348        }
349        if {$detailwidget ne ""} {
350            pack $detailwidget -expand yes -fill both -padx 8 -pady 8
351        }
352    }
353
354    if {[llength $tests] > 0} {
355        eval $testview.overview show $tests
356        if {[llength $tests] == 1 && [$tests getResult] eq "Fail"} {
357            pack $testview.bbar.regoldenize -side left
358            $testview.bbar.regoldenize configure -state normal
359
360            # build up a detailed list of diffs for this one test
361            pack $testview.details -side bottom -expand yes -fill both
362
363            set testobj [lindex $tests 0]
364            $testview.details.scrl.list delete 0 end
365            foreach rec [$testobj getDiffs] {
366                catch {unset diff}
367                array set diff $rec
368
369                set section [string totitle [lindex [split $diff(-path) .] 0]]
370                set title "$section: [$testobj getTestInfo $diff(-path).about.label]"
371                set desc ""
372                set help ""
373
374                set difftype [lindex $diff(-what) 0]
375                set op [lindex $diff(-what) 1]
376                switch -- $difftype {
377                  value {
378                    if {$section eq "Output"} {
379                        set icon [Rappture::icon fail16]
380                        switch -- $op {
381                          - {
382                              set desc "Result is missing from current output"
383                              set help "This result was defined in the test case, but was missing from the output from the current test run.  Perhaps the tool is not producing the result as it should, or else the latest version of the tool no longer produces that result and the test case needs to be updated."
384                          }
385                          + {
386                              set desc "Result was not expected to appear"
387                              set help "The test run contained a result that was not part of the expected output.  Perhaps the tool is not supposed to produce that result, or else the latest version produces a new result and the test case needs to be updated."
388                          }
389                          c {
390                              set desc "Result differs from expected value"
391                              set help "The result from the test run doesn't match the expected result in the test case.  The tool should be fixed to produce the expected result.  If you can verify that the tool is working correctly, then the test case should be updated to contain this new result."
392                          }
393                          default {
394                            error "don't know how to handle difference $op"
395                          }
396                        }
397                    } elseif {$section eq "Input"} {
398                        set icon [Rappture::icon warn16]
399                        switch -- $op {
400                          - {
401                              set desc "Test case doesn't specify this input value"
402                              set help "The test case is missing a setting for this input value that appears in the current tool definition.  Is this a new input that was recently added to the tool?  If so, the test case should be updated."
403                          }
404                          + {
405                              set desc "Test case has this extra input value"
406                              set help "The test case has an extra input value that does not appear in the current tool definition.  Was this input recently removed from the tool?  If so, the test case should be updated."
407                          }
408                          c {
409                              # don't give a warning in this case
410                              # input is supposed to be different from tool.xml
411                          }
412                          default {
413                            error "don't know how to handle difference $op"
414                          }
415                        }
416                    }
417                  }
418                  attrs {
419                    if {$section eq "Output"} {
420                        set icon [Rappture::icon warn16]
421                        set desc "Details about this result have changed"
422                        set help "The test run produced an output with slightly different information.  This may be as simple as a change in the label or description, or as serious as a change in the physical system of units.  Perhaps the tool is producing the wrong output, or else the tool has been modified and the test case needs to be updated."
423                    } elseif {$section eq "Input"} {
424                        set icon [Rappture::icon warn16]
425                        set desc "Details about this result have changed"
426                        set help "The test run contains an input with slightly different information.  This may be as simple as a change in the label or description, or as serious as a change in the physical system of units.  Perhaps this input has been modified in the latest version of the tool and the test case is outdated."
427                    }
428                  }
429                  type {
430                    if {$section eq "Output"} {
431                        set icon [Rappture::icon fail16]
432                        set desc "Result has the wrong type"
433                        set help "The test run contains an output that is completely different from what was expected--not even the same type of object.  The tool should be fixed to produce the expected result.  If you can verify that the tool is working correctly, then the test case should be updated to contain this new result."
434                    } elseif {$section eq "Input"} {
435                        set icon [Rappture::icon warn16]
436                        set desc "Input value has a different type"
437                        set help "The test run contains an output that is completely different from what was expected--not even the same type of object.  The tool should be fixed to produce the expected result.  If you can verify that the tool is working correctly, then the test case should be updated to contain this new result."
438                        set help "The test run contains an input value that is completely different from the corresponding input defined in the test case.  Was this input recently modified in the tool?  If so, the test case should be updated."
439                    }
440                  }
441                  status {
442                    set icon [Rappture::icon fail16]
443                    set title "Run failure"
444                    if {$diff(-path) eq "output.status"} {
445                        set desc "Test run failure was not expected"
446                        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."
447                    } else {
448                        set desc "Test run failure produced different output"
449                        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."
450                    }
451                  }
452                  unkobj {
453                    set icon [Rappture::icon warn16]
454                    set title "Unsupported object type"
455                    set desc "Test contains an object type that is not yet supported"
456                    set help "The Rappture Regression Tester is still in beta.  Some object types supported by the Rappture runtime environment are not yet supported by the tester.  These warnings will go away as the Rappture Regression Tester improves and support for all object types is put into place."
457                  }
458                  default {
459                    error "don't know how to handle difference \"$difftype\""
460                  }
461                }
462
463                # add to the list of differences
464                if {$desc ne ""} {
465                    $testview.details.scrl.list insert end \
466                        -title $title -subtitle $diff(-path) \
467                        -icon $icon -body $desc -help $help \
468                        -clientdata [linsert $rec 0 -testobj $testobj]
469                }
470            }
471
472        } else {
473            $testview.bbar.regoldenize configure -state disabled
474            pack forget $testview.details $testview.bbar.regoldenize
475        }
476    }
477}
478
479# ----------------------------------------------------------------------
480# USAGE: tester_run <testObj> <testObj> ...
481#
482# Invoked whenever the user presses the "Run" button for one or more
483# selected tests.  Puts the tool into "run" mode and starts running
484# the various test cases.
485# ----------------------------------------------------------------------
486proc tester_run {args} {
487    # set up a callback for handling output from runs
488    Rappture::Tester::Test::queue status tester_run_output
489
490    # add these tests to the run queue
491    eval Rappture::Tester::Test::queue add $args
492
493    # show the run output window
494    set rhs [.pw pane 1]
495    foreach win [pack slaves $rhs] {
496        pack forget $win
497    }
498    pack $rhs.testrun -expand yes -fill both -padx 8 -pady 8
499}
500
501# ----------------------------------------------------------------------
502# USAGE: tester_run_output start <testObj>
503# USAGE: tester_run_output add <testObj> <string>
504#
505# Handles the output from running tests.  The "start" option clears
506# the current output area.  The "add" option adds output from a run.
507# ----------------------------------------------------------------------
508proc tester_run_output {option testobj args} {
509    set testrun [.pw pane 1].testrun
510
511    switch -- $option {
512        start {
513            # clear out any previous output
514            $testrun.scrl.info configure -state normal
515            $testrun.scrl.info delete 1.0 end
516            $testrun.scrl.info configure -state disabled
517
518            # plug this object into the "Abort" button
519            $testrun.abort configure -command [list $testobj abort]
520
521            # hide progress bar
522            pack forget $testrun.progress
523        }
524        add {
525            set message [lindex $args 0]
526            # scan for progress updates
527            while {[regexp -indices \
528                {=RAPPTURE-PROGRESS=> *([-+]?[0-9]+) +([^\n]*)(\n|$)} $message \
529                 match percent mesg]} {
530
531                foreach {i0 i1} $percent break
532                set percent [string range $message $i0 $i1]
533
534                foreach {i0 i1} $mesg break
535                set mesg [string range $message $i0 $i1]
536
537                pack $testrun.progress -fill x -padx 10 -pady 10
538                $testrun.progress settings -percent $percent -message $mesg
539
540                foreach {i0 i1} $match break
541                set message [string replace $message $i0 $i1]
542            }
543
544            $testrun.scrl.info configure -state normal
545            $testrun.scrl.info insert end $message
546
547            # if there are too many lines, delete some
548            set lines [lindex [split [$testrun.scrl.info index end-2char] .] 0]
549            if {$lines > 500} {
550                set extra [expr {$lines-500+1}]
551                $testrun.scrl.info delete 1.0 $extra.0
552            }
553
554            # show the newest stuff
555            $testrun.scrl.info see end
556            $testrun.scrl.info configure -state disabled
557        }
558        default {
559            error "bad option \"$option\": should be start, add"
560        }
561    }
562}
563
564# ----------------------------------------------------------------------
565# USAGE: tester_diff_show -option value -option value ...
566#
567# Pops up a panel showing more detailed information about a particular
568# difference found in a particular test case.
569# ----------------------------------------------------------------------
570proc tester_diff_show {args} {
571    global DiffShow
572
573    set testtree [.pw pane 0].tree
574    set rhs [.pw pane 1]
575    set testview $rhs.testview
576    set viewarea [.testdiffs.body.val2objs pane 0].val
577
578    # clean up from the last call
579    set viewer [lindex $DiffShow 0]
580    if {$viewer ne ""} {
581        $viewer delete
582        foreach obj [lrange $DiffShow 1 end] {
583            itcl::delete object $obj
584        }
585    }
586    set DiffShow ""
587
588    # show the diff overview in the header
589    array set data $args
590    .testdiffs.hd.inner.title configure -image $data(-icon) -text $data(-body)
591
592    #
593    # Figure out how to visualize the difference.
594    #
595    array set diff $data(-clientdata)
596
597    if {[info exists data(-help)]} {
598        Rappture::Tooltip::text .testdiffs.hd.inner.help $data(-help)
599    } else {
600        Rappture::Tooltip::text .testdiffs.hd.inner.help ""
601    }
602
603    switch -glob -- $diff(-what) {
604        "value *" {
605            foreach w [pack slaves $viewarea] {
606                pack forget $w
607            }
608
609            set op [lindex $diff(-what) 1]
610            set w .testdiffs.body.val1str.obj
611            switch -- $op {
612                +       { set bg [$w cget -addedbackground] }
613                -       { set bg [$w cget -deletedbackground] }
614                default { set bg [lindex [$w configure -background] 3] }
615            }
616
617            # get the first value in obj or string form
618            set val1 ""
619            if {[catch {Rappture::objects::import $diff(-obj1) $diff(-path)} val1] == 0 && $val1 ne ""} {
620                set viewer [Rappture::objects::viewer $val1 \
621                    -for output -parent $viewarea]
622                if {$viewer ne ""} {
623                    set DiffShow [list $viewer $val1]
624                }
625                # try to get a string rep too
626                set status [$val1 export string str]
627                if {[lindex $status 0]} { set vstr1 $str }
628            }
629
630            # get a string rep for the second value
631            set val2 ""
632            if {[catch {Rappture::objects::import $diff(-obj2) $diff(-path)} val2] == 0 && $val2 ne ""} {
633                set viewer [Rappture::objects::viewer $val2 \
634                    -for output -parent $viewarea]
635                if {$viewer ne ""} {
636                    if {$DiffShow ne ""} {
637                        if {[lindex $DiffShow 0] eq $viewer} {
638                            lappend DiffShow $val2
639                        } else {
640                            error "type mismatch between values: $diff(-obj1) vs $diff(-obj2) -- diff should have caught this as \"type\" difference"
641                        }
642                    } else {
643                        set DiffShow [list $viewer $val2]
644                    }
645                }
646                # try to get a string rep too
647                set status [$val2 export string str]
648                if {[lindex $status 0]} { set vstr2 $str }
649            }
650
651            if {$DiffShow ne ""} {
652                # we have a value viewer -- show the values in that
653                pack $viewer -expand yes -fill both
654
655                if {$val1 ne ""} {
656                    $viewer add $val1 [list -color black -description "Expected Result"]
657                }
658                if {$val2 ne ""} {
659                    $viewer add $val2 [list -color red -description "Test Result"]
660                }
661
662                # show the string diffs too
663                set w [.testdiffs.body.val2objs pane 1]
664                $w.obj configure -background $bg \
665                    -testobj $diff(-testobj) -path $diff(-path)
666
667                if {[info exists vstr1]} { set v1 $vstr1 } else { set v1 "" }
668                if {[info exists vstr2]} { set v2 $vstr2 } else { set v2 "" }
669                $w.diffs show $v1 $v2
670
671                set win .testdiffs.body.val2objs
672
673                set legsettings [list 2 normal \
674                    3 [expr {($val2 ne "") ? "normal" : "disabled"}] \
675                    4 [expr {($val1 ne "") ? "normal" : "disabled"}]]
676
677            } elseif {[info exists vstr1] && [info exists vstr2]} {
678                # we have two value strings -- show as a diff
679                set win .testdiffs.body.val2strs
680                $win.obj configure -background $bg \
681                    -testobj $diff(-testobj) -path $diff(-path)
682                $win.diffs show $vstr1 $vstr2
683                set legsettings {2 normal 3 disabled 4 disabled}
684            } elseif {[info exists vstr1] || [info exists vstr2]} {
685                # we have one value string -- show it
686                if {[info exists vstr1]} {
687                    set val $vstr1
688                } else {
689                    set val $vstr2
690                }
691                set win .testdiffs.body.val1str
692                $win.obj configure -background $bg \
693                    -testobj $diff(-testobj) -path $diff(-path)
694                $win.scrl.text configure -state normal
695                $win.scrl.text delete 1.0 end
696                $win.scrl.text insert end $val
697                $win.scrl.text configure -state disabled
698                set legsettings {2 disabled 3 disabled 4 disabled}
699            } else {
700                # don't have a value -- show the attributes
701                set win .testdiffs.body.val
702                $win.obj configure -background $bg \
703                    -testobj $diff(-testobj) -path $diff(-path)
704                set legsettings {2 disabled 3 disabled 4 disabled}
705            }
706
707            # clean up any objects that are not being stored
708            if {$val1 ne "" && [lsearch $DiffShow $val1] < 0} {
709                itcl::delete object $val1
710            }
711            if {$val2 ne "" && [lsearch $DiffShow $val2] < 0} {
712                itcl::delete object $val2
713            }
714        }
715        "attrs *" {
716            set win .testdiffs.body.attrs
717            set bg [lindex [$win configure -background] 3]
718            $win configure -testobj $diff(-testobj) -background $bg \
719                -path $diff(-path) -details max -showdiffs yes
720            set legsettings {2 disabled 3 disabled 4 disabled}
721        }
722        "status" {
723            set win .testdiffs.body.runs
724            $win configure -testobj $diff(-testobj) -showdiffs yes
725            set legsettings {2 disabled 3 disabled 4 disabled}
726        }
727        "type *" {
728            error "don't know how to show type diffs"
729            set legsettings {2 disabled 3 disabled 4 disabled}
730        }
731        "unkobj" {
732            set win .testdiffs.body.info
733            $win.text configure -state normal
734            $win.text delete 1.0 end
735            $win.text insert end "The following object type is not yet supported within the Rappture Regression Tester:\n\n[$diff(-testobj) getTestInfo xml $diff(-path)]"
736            $win.text configure -state disabled
737            set legsettings {2 disabled 3 disabled 4 disabled}
738        }
739    }
740    if {[pack slaves .testdiffs.body] ne $win} {
741        foreach w [pack slaves .testdiffs.body] {
742            pack forget $w
743        }
744        pack $win -expand yes -fill both
745    }
746
747    # fix up the legend to best explain the current result
748    foreach {index state} $legsettings {
749        .testdiffs.legend itemconfigure $index -state $state
750    }
751
752    # pop up the viewer
753    place .testdiffs -x 0 -y 0 -anchor nw -relwidth 1 -relheight 1
754    raise .testdiffs
755}
756
757# ----------------------------------------------------------------------
758# USAGE: tester_diff_hide
759#
760# Takes down the panel posted by tester_diff_show.
761# ----------------------------------------------------------------------
762proc tester_diff_hide {} {
763    place forget .testdiffs
764}
765
766# ----------------------------------------------------------------------
767# USAGE: tester_regoldenize
768#
769# Regoldenizes the currently focused test case.  Displays a warning
770# message.  If confirmed, copy the test information from the existing
771# test xml into the new result, and write the new data into the test
772# xml.
773# ----------------------------------------------------------------------
774proc tester_regoldenize {} {
775    set testtree [.pw pane 0].tree
776    set seltests [$testtree curselection]
777
778    if {[llength $seltests] != 1} {
779        error "Oops! Multiple tests selected to regoldenize.  How did we get here?"
780    }
781
782    set test [lindex $seltests 0]
783    set testxml [$test getTestxml]
784    if {[tk_messageBox -type yesno -icon warning -title "Rappture Tester: Confirm" -message "Are you sure that the latest run results are completely correct for this test case?  If so, then $testxml will be overwritten with the latest output, and all future test runs will be compared with this new standard.\n\nContinue?"]} {
785        $test regoldenize
786
787        # reload the updated description for this test
788        tester_selection_changed
789    }
790}
791
792wm deiconify .
Note: See TracBrowser for help on using the repository browser.