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

Last change on this file since 2165 was 2165, checked in by mmc, 11 years ago

A couple of fixes to better handle the case where an input is hanging
around in a test case but has been removed from the tool.xml. It now
reports it as having different attributes. It should report it as
an unexpected input, but still working on that...

  • Property svn:executable set to *
File size: 33.8 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#  AUTHOR:  Ben Rafferty, Purdue University
20#  Copyright (c) 2010  Purdue Research Foundation
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 ToolObj [Rappture::Tool ::#auto $xmlobj $installdir]
139set DiffShow ""  ;# used to track which diff objects are being displayed
140
141# ----------------------------------------------------------------------
142# INITIALIZE WINDOW
143# ----------------------------------------------------------------------
144wm title . "Rappture Regression Tester"
145wm geometry . 800x500
146Rappture::Panes .pw -orientation horizontal -sashcursor sb_h_double_arrow
147pack .pw -expand yes -fill both
148
149set win [.pw pane 0]
150Rappture::Tester::TestTree $win.tree \
151    -selectcommand tester_selection_changed
152pack $win.tree -expand yes -fill both -padx 8 -pady 8
153
154set win [.pw insert end -fraction 0.8]
155
156# Frame for viewing tests
157# ----------------------------------------------------------------------
158frame $win.testview
159frame $win.testview.bbar
160pack $win.testview.bbar -side bottom -fill x -pady {8 0}
161button $win.testview.bbar.regoldenize -text "<< New golden standard" \
162    -state disabled -command tester_regoldenize
163pack $win.testview.bbar.regoldenize -side left
164Rappture::Tooltip::for $win.testview.bbar.regoldenize \
165    "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."
166
167pack $win.testview.bbar -side bottom -fill x
168
169Rappture::Tester::TestView $win.testview.overview \
170    -runcommand tester_run
171pack $win.testview.overview -side top -fill both -padx 8 -pady 8
172
173frame $win.testview.details
174label $win.testview.details.heading -text "Differences:"
175pack $win.testview.details.heading -side top -anchor w
176Rappture::Scroller $win.testview.details.scrl \
177    -xscrollmode auto -yscrollmode auto
178pack $win.testview.details.scrl -expand yes -fill both
179Rappture::Tester::StatusList $win.testview.details.scrl.list \
180    -viewcommand tester_diff_show
181$win.testview.details.scrl contents $win.testview.details.scrl.list
182
183# Frame for viewing running tests
184# ----------------------------------------------------------------------
185frame $win.testrun
186label $win.testrun.title -text "Output from test run:" -anchor w
187pack $win.testrun.title -side top -anchor w
188
189Rappture::Progress $win.testrun.progress
190button $win.testrun.abort -text "Abort"
191pack $win.testrun.abort -side bottom -pady {8 0}
192
193Rappture::Scroller $win.testrun.scrl -xscrollmode auto -yscrollmode auto
194pack $win.testrun.scrl -expand yes -fill both
195text $win.testrun.scrl.info -width 1 -height 1 -wrap none
196$win.testrun.scrl contents $win.testrun.scrl.info
197
198# Frame for viewing diffs
199# ---------------------------------------------------------------------
200frame .testdiffs -borderwidth 10 -relief flat
201
202# header at the top with info about the diff, help, and close button
203frame .testdiffs.hd -borderwidth 4 -relief flat
204pack .testdiffs.hd -side top -fill x
205frame .testdiffs.hd.inner -highlightthickness 1 -borderwidth 2 -relief flat
206pack .testdiffs.hd.inner -expand yes -fill both
207button .testdiffs.hd.inner.close -relief flat -overrelief raised \
208    -bitmap [Rappture::icon dismiss] -command tester_diff_hide
209pack .testdiffs.hd.inner.close -side right -padx 8
210label .testdiffs.hd.inner.title -compound left -anchor w -padx 8
211pack .testdiffs.hd.inner.title -side left
212button .testdiffs.hd.inner.help -anchor w -text "Help..." \
213    -command "::Rappture::Tooltip::tooltip show .testdiffs.hd.inner.help +10,0"
214pack .testdiffs.hd.inner.help -side left -padx 10
215
216# show add/deleted styles at the bottom
217Rappture::Tester::Legend .testdiffs.legend
218pack .testdiffs.legend -side bottom -fill x
219frame .testdiffs.line -height 1 -background black
220pack .testdiffs.line -side bottom -fill x -pady {0 2}
221
222# diff viewer goes in this spot
223frame .testdiffs.body
224pack .testdiffs.body -expand yes -fill both -padx 10 -pady {20 10}
225
226# viewer for attribute diffs
227Rappture::Tester::ObjView .testdiffs.body.attrs
228
229# viewer for run status diffs
230Rappture::Tester::RunView .testdiffs.body.runs
231
232# viewer for value diffs where object is extra or missing
233frame .testdiffs.body.val
234Rappture::Tester::ObjView .testdiffs.body.val.obj -details max -showdiffs no
235pack .testdiffs.body.val.obj -expand yes -fill both
236
237# viewer for value diffs where we have just one string
238frame .testdiffs.body.val1str
239Rappture::Tester::ObjView .testdiffs.body.val1str.obj \
240    -details min -showdiffs no
241pack .testdiffs.body.val1str.obj -side top -fill x
242label .testdiffs.body.val1str.l -text "Value:"
243pack .testdiffs.body.val1str.l -anchor w -padx 10 -pady {10 0}
244Rappture::Scroller .testdiffs.body.val1str.scrl \
245    -xscrollmode auto -yscrollmode auto
246pack .testdiffs.body.val1str.scrl -expand yes -fill both -padx 10 -pady {0 10}
247text .testdiffs.body.val1str.scrl.text -width 10 -height 1 -wrap char
248.testdiffs.body.val1str.scrl contents .testdiffs.body.val1str.scrl.text
249
250# viewer for value diffs where we have two strings but no special viewers
251frame .testdiffs.body.val2strs
252Rappture::Tester::ObjView .testdiffs.body.val2strs.obj \
253    -details min -showdiffs no
254pack .testdiffs.body.val2strs.obj -side top -fill x
255Rappture::Tester::StringDiffs .testdiffs.body.val2strs.diffs \
256    -title1 "Expected this:" -title2 "Got this:"
257pack .testdiffs.body.val2strs.diffs -expand yes -fill both -padx 10 -pady 10
258
259# viewer for value diffs where we have a special object viewer
260Rappture::Panes .testdiffs.body.val2objs -orientation horizontal -sashcursor sb_h_double_arrow
261
262# empty area for the object value viewer
263set win [.testdiffs.body.val2objs pane 0]
264frame $win.val
265pack $win.val -expand yes -fill both
266
267# show object details and diff on the right-hand side
268set win [.testdiffs.body.val2objs insert end -fraction 0.5]
269Rappture::Tester::ObjView $win.obj -details min -showdiffs no
270pack $win.obj -side top -fill x
271Rappture::Tester::StringDiffs $win.diffs \
272    -title1 "Expected this:" -title2 "Got this:"
273pack $win.diffs -expand yes -fill both -padx 4 -pady 4
274
275# viewer for showing string info if all else fails (e.g. unkobj errors)
276Rappture::Scroller .testdiffs.body.info \
277    -xscrollmode auto -yscrollmode auto
278pack .testdiffs.body.info -expand yes -fill both -padx 10 -pady {0 10}
279text .testdiffs.body.info.text -width 10 -height 1 -wrap char
280.testdiffs.body.info contents .testdiffs.body.info.text
281
282# plug the proper diff colors into the legend area
283.testdiffs.legend insert end -title "= Added" -shape box \
284    -color [.testdiffs.body.val2strs.diffs cget -addedbackground]
285.testdiffs.legend insert end -title "= Deleted" -shape box \
286    -color [.testdiffs.body.val2strs.diffs cget -deletedbackground]
287.testdiffs.legend insert end -title "= Changed" -shape box \
288    -color [.testdiffs.body.val2strs.diffs cget -changedbackground]
289.testdiffs.legend insert end -title "= Test Result" -shape line \
290    -color red -anchor e
291.testdiffs.legend insert end -title "= Expected Result" -shape line \
292    -color black -anchor e
293
294# Load all tests in the test directory
295# ----------------------------------------------------------------------
296set testtree [.pw pane 0].tree
297foreach file [glob -nocomplain -directory $params(-testdir) *.xml] {
298    set testobj [Rappture::Tester::Test ::#auto $ToolObj $file]
299    $testtree add $testobj
300}
301$testtree component treeview open -recurse root
302
303# ----------------------------------------------------------------------
304# USAGE: tester_selection_changed
305#
306# Invoked automatically whenever the selection changes in the tree
307# on the left.  Brings up a description of one or more selected tests
308# on the right-hand side.
309# ----------------------------------------------------------------------
310proc tester_selection_changed {args} {
311    set testtree [.pw pane 0].tree
312    set rhs [.pw pane 1]
313    set testview $rhs.testview
314    set tests [$testtree curselection]
315
316    # figure out what we should be showing on the right-hand side
317    if {[llength $tests] > 0} {
318        set status "?"
319        foreach obj $tests {
320            if {[$obj getResult] == "Running"} {
321                set status "Running"
322            }
323        }
324        if {$status == "Running"} {
325            set detailwidget $rhs.testrun
326        } else {
327            set detailwidget $rhs.testview
328        }
329    } else {
330        set detailwidget ""
331    }
332
333    # repack the right-hand side, if necessary
334    if {$detailwidget ne [pack slaves $rhs]} {
335        foreach win [pack slaves $rhs] {
336            pack forget $win
337        }
338        if {$detailwidget ne ""} {
339            pack $detailwidget -expand yes -fill both -padx 8 -pady 8
340        }
341    }
342
343    if {[llength $tests] > 0} {
344        eval $testview.overview show $tests
345        if {[llength $tests] == 1 && [$tests getResult] eq "Fail"} {
346            pack $testview.bbar.regoldenize -side left
347            $testview.bbar.regoldenize configure -state normal
348
349            # build up a detailed list of diffs for this one test
350            pack $testview.details -side bottom -expand yes -fill both
351
352            set testobj [lindex $tests 0]
353            $testview.details.scrl.list delete 0 end
354            foreach rec [$testobj getDiffs] {
355                catch {unset diff}
356                array set diff $rec
357
358                set section [string totitle [lindex [split $diff(-path) .] 0]]
359                set title "$section: [$testobj getTestInfo $diff(-path).about.label]"
360                set desc ""
361                set help ""
362
363                set difftype [lindex $diff(-what) 0]
364                set op [lindex $diff(-what) 1]
365                switch -- $difftype {
366                  value {
367                    if {$section eq "Output"} {
368                        set icon [Rappture::icon fail16]
369                        switch -- $op {
370                          - {
371                              set desc "Result is missing from current output"
372                              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."
373                          }
374                          + {
375                              set desc "Result was not expected to appear"
376                              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."
377                          }
378                          c {
379                              set desc "Result differs from expected value"
380                              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."
381                          }
382                          default {
383                            error "don't know how to handle difference $op"
384                          }
385                        }
386                    } elseif {$section eq "Input"} {
387                        set icon [Rappture::icon warn16]
388                        switch -- $op {
389                          - {
390                              set desc "Test case doesn't specify this input value"
391                              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."
392                          }
393                          + {
394                              set desc "Test case has this extra input value"
395                              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."
396                          }
397                          c {
398                              # don't give a warning in this case
399                              # input is supposed to be different from tool.xml
400                          }
401                          default {
402                            error "don't know how to handle difference $op"
403                          }
404                        }
405                    }
406                  }
407                  attrs {
408                    if {$section eq "Output"} {
409                        set icon [Rappture::icon warn16]
410                        set desc "Details about this result have changed"
411                        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."
412                    } elseif {$section eq "Input"} {
413                        set icon [Rappture::icon warn16]
414                        set desc "Details about this result have changed"
415                        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."
416                    }
417                  }
418                  type {
419                    if {$section eq "Output"} {
420                        set icon [Rappture::icon fail16]
421                        set desc "Result has the wrong type"
422                        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."
423                    } elseif {$section eq "Input"} {
424                        set icon [Rappture::icon warn16]
425                        set desc "Input value has a different type"
426                        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."
427                        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."
428                    }
429                  }
430                  status {
431                    set icon [Rappture::icon fail16]
432                    set title "Run failure"
433                    if {$diff(-path) eq "output.status"} {
434                        set desc "Test run failure was not expected"
435                        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."
436                    } else {
437                        set desc "Test run failure produced different output"
438                        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."
439                    }
440                  }
441                  unkobj {
442                    set icon [Rappture::icon warn16]
443                    set title "Unsupported object type"
444                    set desc "Test contains an object type that is not yet supported"
445                    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."
446                  }
447                  default {
448                    error "don't know how to handle difference \"$difftype\""
449                  }
450                }
451
452                # add to the list of differences
453                if {$desc ne ""} {
454                    $testview.details.scrl.list insert end \
455                        -title $title -subtitle $diff(-path) \
456                        -icon $icon -body $desc -help $help \
457                        -clientdata [linsert $rec 0 -testobj $testobj]
458                }
459            }
460
461        } else {
462            $testview.bbar.regoldenize configure -state disabled
463            pack forget $testview.details $testview.bbar.regoldenize
464        }
465    }
466}
467
468# ----------------------------------------------------------------------
469# USAGE: tester_run <testObj> <testObj> ...
470#
471# Invoked whenever the user presses the "Run" button for one or more
472# selected tests.  Puts the tool into "run" mode and starts running
473# the various test cases.
474# ----------------------------------------------------------------------
475proc tester_run {args} {
476    # set up a callback for handling output from runs
477    Rappture::Tester::Test::queue status tester_run_output
478
479    # add these tests to the run queue
480    eval Rappture::Tester::Test::queue add $args
481
482    # show the run output window
483    set rhs [.pw pane 1]
484    foreach win [pack slaves $rhs] {
485        pack forget $win
486    }
487    pack $rhs.testrun -expand yes -fill both -padx 8 -pady 8
488}
489
490# ----------------------------------------------------------------------
491# USAGE: tester_run_output start <testObj>
492# USAGE: tester_run_output add <testObj> <string>
493#
494# Handles the output from running tests.  The "start" option clears
495# the current output area.  The "add" option adds output from a run.
496# ----------------------------------------------------------------------
497proc tester_run_output {option testobj args} {
498    set testrun [.pw pane 1].testrun
499
500    switch -- $option {
501        start {
502            # clear out any previous output
503            $testrun.scrl.info configure -state normal
504            $testrun.scrl.info delete 1.0 end
505            $testrun.scrl.info configure -state disabled
506
507            # plug this object into the "Abort" button
508            $testrun.abort configure -command [list $testobj abort]
509
510            # hide progress bar
511            pack forget $testrun.progress
512        }
513        add {
514            set message [lindex $args 0]
515            # scan for progress updates
516            while {[regexp -indices \
517                {=RAPPTURE-PROGRESS=> *([-+]?[0-9]+) +([^\n]*)(\n|$)} $message \
518                 match percent mesg]} {
519
520                foreach {i0 i1} $percent break
521                set percent [string range $message $i0 $i1]
522
523                foreach {i0 i1} $mesg break
524                set mesg [string range $message $i0 $i1]
525
526                pack $testrun.progress -fill x -padx 10 -pady 10
527                $testrun.progress settings -percent $percent -message $mesg
528
529                foreach {i0 i1} $match break
530                set message [string replace $message $i0 $i1]
531            }
532
533            $testrun.scrl.info configure -state normal
534            $testrun.scrl.info insert end $message
535
536            # if there are too many lines, delete some
537            set lines [lindex [split [$testrun.scrl.info index end-2char] .] 0]
538            if {$lines > 500} {
539                set extra [expr {$lines-500+1}]
540                $testrun.scrl.info delete 1.0 $extra.0
541            }
542
543            # show the newest stuff
544            $testrun.scrl.info see end
545            $testrun.scrl.info configure -state disabled
546        }
547        default {
548            error "bad option \"$option\": should be start, add"
549        }
550    }
551}
552
553# ----------------------------------------------------------------------
554# USAGE: tester_diff_show -option value -option value ...
555#
556# Pops up a panel showing more detailed information about a particular
557# difference found in a particular test case.
558# ----------------------------------------------------------------------
559proc tester_diff_show {args} {
560    global DiffShow
561
562    set testtree [.pw pane 0].tree
563    set rhs [.pw pane 1]
564    set testview $rhs.testview
565    set viewarea [.testdiffs.body.val2objs pane 0].val
566
567    # clean up from the last call
568    set viewer [lindex $DiffShow 0]
569    if {$viewer ne ""} {
570        $viewer delete
571        foreach obj [lrange $DiffShow 1 end] {
572            itcl::delete object $obj
573        }
574    }
575    set DiffShow ""
576
577    # show the diff overview in the header
578    array set data $args
579    .testdiffs.hd.inner.title configure -image $data(-icon) -text $data(-body)
580
581    #
582    # Figure out how to visualize the difference.
583    #
584    array set diff $data(-clientdata)
585
586    if {[info exists data(-help)]} {
587        Rappture::Tooltip::text .testdiffs.hd.inner.help $data(-help)
588    } else {
589        Rappture::Tooltip::text .testdiffs.hd.inner.help ""
590    }
591
592    switch -glob -- $diff(-what) {
593        "value *" {
594            foreach w [pack slaves $viewarea] {
595                pack forget $w
596            }
597
598            set op [lindex $diff(-what) 1]
599            set w .testdiffs.body.val1str.obj
600            switch -- $op {
601                +       { set bg [$w cget -addedbackground] }
602                -       { set bg [$w cget -deletedbackground] }
603                default { set bg [lindex [$w configure -background] 3] }
604            }
605
606            # get the first value in obj or string form
607            set val1 ""
608            if {[catch {Rappture::objects::import $diff(-obj1) $diff(-path)} val1] == 0 && $val1 ne ""} {
609                set viewer [Rappture::objects::viewer $val1 \
610                    -for output -parent $viewarea]
611                if {$viewer ne ""} {
612                    set DiffShow [list $viewer $val1]
613                }
614                # try to get a string rep too
615                set status [$val1 export string str]
616                if {[lindex $status 0]} { set vstr1 $str }
617            }
618
619            # get a string rep for the second value
620            set val2 ""
621            if {[catch {Rappture::objects::import $diff(-obj2) $diff(-path)} val2] == 0 && $val2 ne ""} {
622                set viewer [Rappture::objects::viewer $val2 \
623                    -for output -parent $viewarea]
624                if {$viewer ne ""} {
625                    if {$DiffShow ne ""} {
626                        if {[lindex $DiffShow 0] eq $viewer} {
627                            lappend DiffShow $val2
628                        } else {
629                            error "type mismatch between values: $diff(-obj1) vs $diff(-obj2) -- diff should have caught this as \"type\" difference"
630                        }
631                    } else {
632                        set DiffShow [list $viewer $val2]
633                    }
634                }
635                # try to get a string rep too
636                set status [$val2 export string str]
637                if {[lindex $status 0]} { set vstr2 $str }
638            }
639
640            if {$DiffShow ne ""} {
641                # we have a value viewer -- show the values in that
642                pack $viewer -expand yes -fill both
643
644                if {$val1 ne ""} {
645                    $viewer add $val1 [list -color black -description "Expected Result"]
646                }
647                if {$val2 ne ""} {
648                    $viewer add $val2 [list -color red -description "Test Result"]
649                }
650
651                # show the string diffs too
652                set w [.testdiffs.body.val2objs pane 1]
653                $w.obj configure -background $bg \
654                    -testobj $diff(-testobj) -path $diff(-path)
655
656                if {[info exists vstr1]} { set v1 $vstr1 } else { set v1 "" }
657                if {[info exists vstr2]} { set v2 $vstr2 } else { set v2 "" }
658                $w.diffs show $v1 $v2
659
660                set win .testdiffs.body.val2objs
661
662                set legsettings [list 2 normal \
663                    3 [expr {($val2 ne "") ? "normal" : "disabled"}] \
664                    4 [expr {($val1 ne "") ? "normal" : "disabled"}]]
665
666            } elseif {[info exists vstr1] && [info exists vstr2]} {
667                # we have two value strings -- show as a diff
668                set win .testdiffs.body.val2strs
669                $win.obj configure -background $bg \
670                    -testobj $diff(-testobj) -path $diff(-path)
671                $win.diffs show $vstr1 $vstr2
672                set legsettings {2 normal 3 disabled 4 disabled}
673            } elseif {[info exists vstr1] || [info exists vstr2]} {
674                # we have one value string -- show it
675                if {[info exists vstr1]} {
676                    set val $vstr1
677                } else {
678                    set val $vstr2
679                }
680                set win .testdiffs.body.val1str
681                $win.obj configure -background $bg \
682                    -testobj $diff(-testobj) -path $diff(-path)
683                $win.scrl.text configure -state normal
684                $win.scrl.text delete 1.0 end
685                $win.scrl.text insert end $val
686                $win.scrl.text configure -state disabled
687                set legsettings {2 disabled 3 disabled 4 disabled}
688            } else {
689                # don't have a value -- show the attributes
690                set win .testdiffs.body.val
691                $win.obj configure -background $bg \
692                    -testobj $diff(-testobj) -path $diff(-path)
693                set legsettings {2 disabled 3 disabled 4 disabled}
694            }
695
696            # clean up any objects that are not being stored
697            if {$val1 ne "" && [lsearch $DiffShow $val1] < 0} {
698                itcl::delete object $val1
699            }
700            if {$val2 ne "" && [lsearch $DiffShow $val2] < 0} {
701                itcl::delete object $val2
702            }
703        }
704        "attrs *" {
705            set win .testdiffs.body.attrs
706            set bg [lindex [$win configure -background] 3]
707            $win configure -testobj $diff(-testobj) -background $bg \
708                -path $diff(-path) -details max -showdiffs yes
709            set legsettings {2 disabled 3 disabled 4 disabled}
710        }
711        "status" {
712            set win .testdiffs.body.runs
713            $win configure -testobj $diff(-testobj) -showdiffs yes
714            set legsettings {2 disabled 3 disabled 4 disabled}
715        }
716        "type *" {
717            error "don't know how to show type diffs"
718            set legsettings {2 disabled 3 disabled 4 disabled}
719        }
720        "unkobj" {
721            set win .testdiffs.body.info
722            $win.text configure -state normal
723            $win.text delete 1.0 end
724            $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)]"
725            $win.text configure -state disabled
726            set legsettings {2 disabled 3 disabled 4 disabled}
727        }
728    }
729    if {[pack slaves .testdiffs.body] ne $win} {
730        foreach w [pack slaves .testdiffs.body] {
731            pack forget $w
732        }
733        pack $win -expand yes -fill both
734    }
735
736    # fix up the legend to best explain the current result
737    foreach {index state} $legsettings {
738        .testdiffs.legend itemconfigure $index -state $state
739    }
740
741    # pop up the viewer
742    place .testdiffs -x 0 -y 0 -anchor nw -relwidth 1 -relheight 1
743    raise .testdiffs
744}
745
746# ----------------------------------------------------------------------
747# USAGE: tester_diff_hide
748#
749# Takes down the panel posted by tester_diff_show.
750# ----------------------------------------------------------------------
751proc tester_diff_hide {} {
752    place forget .testdiffs
753}
754
755# ----------------------------------------------------------------------
756# USAGE: tester_regoldenize
757#
758# Regoldenizes the currently focused test case.  Displays a warning
759# message.  If confirmed, copy the test information from the existing
760# test xml into the new result, and write the new data into the test
761# xml.
762# ----------------------------------------------------------------------
763proc tester_regoldenize {} {
764    set testtree [.pw pane 0].tree
765    set seltests [$testtree curselection]
766
767    if {[llength $seltests] != 1} {
768        error "Oops! Multiple tests selected to regoldenize.  How did we get here?"
769    }
770
771    set test [lindex $seltests 0]
772    set testxml [$test getTestxml]
773    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?"]} {
774        $test regoldenize
775
776        # reload the updated description for this test
777        tester_selection_changed
778    }
779}
780
781wm deiconify .
Note: See TracBrowser for help on using the repository browser.