source: branches/blt4/tester/scripts/main.tcl @ 4965

Last change on this file since 4965 was 3959, checked in by gah, 11 years ago

sync with trunk
File size: 34.1 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) 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 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    if {[$testobj getTestInfo test.label] eq ""} {
300        puts stderr "ERROR:  Missing test label in $file"
301        puts stderr "        skipping that test..."
302    } elseif {[catch {$testtree add $testobj} err]} {
303        puts stderr "ERROR:  Can't load test $file"
304        puts stderr "        $err"
305        puts stderr "        skipping that test..."
306    }
307}
308$testtree component treeview open -recurse root
309
310# ----------------------------------------------------------------------
311# USAGE: tester_selection_changed
312#
313# Invoked automatically whenever the selection changes in the tree
314# on the left.  Brings up a description of one or more selected tests
315# on the right-hand side.
316# ----------------------------------------------------------------------
317proc tester_selection_changed {args} {
318    set testtree [.pw pane 0].tree
319    set rhs [.pw pane 1]
320    set testview $rhs.testview
321    set tests [$testtree curselection]
322
323    # figure out what we should be showing on the right-hand side
324    if {[llength $tests] > 0} {
325        set status "?"
326        foreach obj $tests {
327            if {[$obj getResult] == "Running"} {
328                set status "Running"
329            }
330        }
331        if {$status == "Running"} {
332            set detailwidget $rhs.testrun
333        } else {
334            set detailwidget $rhs.testview
335        }
336    } else {
337        set detailwidget ""
338    }
339
340    # repack the right-hand side, if necessary
341    if {$detailwidget ne [pack slaves $rhs]} {
342        foreach win [pack slaves $rhs] {
343            pack forget $win
344        }
345        if {$detailwidget ne ""} {
346            pack $detailwidget -expand yes -fill both -padx 8 -pady 8
347        }
348    }
349
350    if {[llength $tests] > 0} {
351        eval $testview.overview show $tests
352        if {[llength $tests] == 1 && [$tests getResult] eq "Fail"} {
353            pack $testview.bbar.regoldenize -side left
354            $testview.bbar.regoldenize configure -state normal
355
356            # build up a detailed list of diffs for this one test
357            pack $testview.details -side bottom -expand yes -fill both
358
359            set testobj [lindex $tests 0]
360            $testview.details.scrl.list delete 0 end
361            foreach rec [$testobj getDiffs] {
362                catch {unset diff}
363                array set diff $rec
364
365                set section [string totitle [lindex [split $diff(-path) .] 0]]
366                set title "$section: [$testobj getTestInfo $diff(-path).about.label]"
367                set desc ""
368                set help ""
369
370                set difftype [lindex $diff(-what) 0]
371                set op [lindex $diff(-what) 1]
372                switch -- $difftype {
373                  value {
374                    if {$section eq "Output"} {
375                        set icon [Rappture::icon fail16]
376                        switch -- $op {
377                          - {
378                              set desc "Result is missing from current output"
379                              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."
380                          }
381                          + {
382                              set desc "Result was not expected to appear"
383                              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."
384                          }
385                          c {
386                              set desc "Result differs from expected value"
387                              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."
388                          }
389                          default {
390                            error "don't know how to handle difference $op"
391                          }
392                        }
393                    } elseif {$section eq "Input"} {
394                        set icon [Rappture::icon warn16]
395                        switch -- $op {
396                          - {
397                              set desc "Test case doesn't specify this input value"
398                              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."
399                          }
400                          + {
401                              set desc "Test case has this extra input value"
402                              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."
403                          }
404                          c {
405                              # don't give a warning in this case
406                              # input is supposed to be different from tool.xml
407                          }
408                          default {
409                            error "don't know how to handle difference $op"
410                          }
411                        }
412                    }
413                  }
414                  attrs {
415                    if {$section eq "Output"} {
416                        set icon [Rappture::icon warn16]
417                        set desc "Details about this result have changed"
418                        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."
419                    } elseif {$section eq "Input"} {
420                        set icon [Rappture::icon warn16]
421                        set desc "Details about this result have changed"
422                        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."
423                    }
424                  }
425                  type {
426                    if {$section eq "Output"} {
427                        set icon [Rappture::icon fail16]
428                        set desc "Result has the wrong type"
429                        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."
430                    } elseif {$section eq "Input"} {
431                        set icon [Rappture::icon warn16]
432                        set desc "Input value has a different 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                        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."
435                    }
436                  }
437                  status {
438                    set icon [Rappture::icon fail16]
439                    set title "Run failure"
440                    if {$diff(-path) eq "output.status"} {
441                        set desc "Test run failure was not expected"
442                        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."
443                    } else {
444                        set desc "Test run failure produced different output"
445                        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."
446                    }
447                  }
448                  unkobj {
449                    set icon [Rappture::icon warn16]
450                    set title "Unsupported object type"
451                    set desc "Test contains an object type that is not yet supported"
452                    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."
453                  }
454                  default {
455                    error "don't know how to handle difference \"$difftype\""
456                  }
457                }
458
459                # add to the list of differences
460                if {$desc ne ""} {
461                    $testview.details.scrl.list insert end \
462                        -title $title -subtitle $diff(-path) \
463                        -icon $icon -body $desc -help $help \
464                        -clientdata [linsert $rec 0 -testobj $testobj]
465                }
466            }
467
468        } else {
469            $testview.bbar.regoldenize configure -state disabled
470            pack forget $testview.details $testview.bbar.regoldenize
471        }
472    }
473}
474
475# ----------------------------------------------------------------------
476# USAGE: tester_run <testObj> <testObj> ...
477#
478# Invoked whenever the user presses the "Run" button for one or more
479# selected tests.  Puts the tool into "run" mode and starts running
480# the various test cases.
481# ----------------------------------------------------------------------
482proc tester_run {args} {
483    # set up a callback for handling output from runs
484    Rappture::Tester::Test::queue status tester_run_output
485
486    # add these tests to the run queue
487    eval Rappture::Tester::Test::queue add $args
488
489    # show the run output window
490    set rhs [.pw pane 1]
491    foreach win [pack slaves $rhs] {
492        pack forget $win
493    }
494    pack $rhs.testrun -expand yes -fill both -padx 8 -pady 8
495}
496
497# ----------------------------------------------------------------------
498# USAGE: tester_run_output start <testObj>
499# USAGE: tester_run_output add <testObj> <string>
500#
501# Handles the output from running tests.  The "start" option clears
502# the current output area.  The "add" option adds output from a run.
503# ----------------------------------------------------------------------
504proc tester_run_output {option testobj args} {
505    set testrun [.pw pane 1].testrun
506
507    switch -- $option {
508        start {
509            # clear out any previous output
510            $testrun.scrl.info configure -state normal
511            $testrun.scrl.info delete 1.0 end
512            $testrun.scrl.info configure -state disabled
513
514            # plug this object into the "Abort" button
515            $testrun.abort configure -command [list $testobj abort]
516
517            # hide progress bar
518            pack forget $testrun.progress
519        }
520        add {
521            set message [lindex $args 0]
522            # scan for progress updates
523            while {[regexp -indices \
524                {=RAPPTURE-PROGRESS=> *([-+]?[0-9]+) +([^\n]*)(\n|$)} $message \
525                 match percent mesg]} {
526
527                foreach {i0 i1} $percent break
528                set percent [string range $message $i0 $i1]
529
530                foreach {i0 i1} $mesg break
531                set mesg [string range $message $i0 $i1]
532
533                pack $testrun.progress -fill x -padx 10 -pady 10
534                $testrun.progress settings -percent $percent -message $mesg
535
536                foreach {i0 i1} $match break
537                set message [string replace $message $i0 $i1]
538            }
539
540            $testrun.scrl.info configure -state normal
541            $testrun.scrl.info insert end $message
542
543            # if there are too many lines, delete some
544            set lines [lindex [split [$testrun.scrl.info index end-2char] .] 0]
545            if {$lines > 500} {
546                set extra [expr {$lines-500+1}]
547                $testrun.scrl.info delete 1.0 $extra.0
548            }
549
550            # show the newest stuff
551            $testrun.scrl.info see end
552            $testrun.scrl.info configure -state disabled
553        }
554        default {
555            error "bad option \"$option\": should be start, add"
556        }
557    }
558}
559
560# ----------------------------------------------------------------------
561# USAGE: tester_diff_show -option value -option value ...
562#
563# Pops up a panel showing more detailed information about a particular
564# difference found in a particular test case.
565# ----------------------------------------------------------------------
566proc tester_diff_show {args} {
567    global DiffShow
568
569    set testtree [.pw pane 0].tree
570    set rhs [.pw pane 1]
571    set testview $rhs.testview
572    set viewarea [.testdiffs.body.val2objs pane 0].val
573
574    # clean up from the last call
575    set viewer [lindex $DiffShow 0]
576    if {$viewer ne ""} {
577        $viewer delete
578        foreach obj [lrange $DiffShow 1 end] {
579            itcl::delete object $obj
580        }
581    }
582    set DiffShow ""
583
584    # show the diff overview in the header
585    array set data $args
586    .testdiffs.hd.inner.title configure -image $data(-icon) -text $data(-body)
587
588    #
589    # Figure out how to visualize the difference.
590    #
591    array set diff $data(-clientdata)
592
593    if {[info exists data(-help)]} {
594        Rappture::Tooltip::text .testdiffs.hd.inner.help $data(-help)
595    } else {
596        Rappture::Tooltip::text .testdiffs.hd.inner.help ""
597    }
598
599    switch -glob -- $diff(-what) {
600        "value *" {
601            foreach w [pack slaves $viewarea] {
602                pack forget $w
603            }
604
605            set op [lindex $diff(-what) 1]
606            set w .testdiffs.body.val1str.obj
607            switch -- $op {
608                +       { set bg [$w cget -addedbackground] }
609                -       { set bg [$w cget -deletedbackground] }
610                default { set bg [lindex [$w configure -background] 3] }
611            }
612
613            # get the first value in obj or string form
614            set val1 ""
615            if {[catch {Rappture::objects::import $diff(-obj1) $diff(-path)} val1] == 0 && $val1 ne ""} {
616                set viewer [Rappture::objects::viewer $val1 \
617                    -for output -parent $viewarea]
618                if {$viewer ne ""} {
619                    set DiffShow [list $viewer $val1]
620                }
621                # try to get a string rep too
622                set status [$val1 export string str]
623                if {[lindex $status 0]} { set vstr1 $str }
624            }
625
626            # get a string rep for the second value
627            set val2 ""
628            if {[catch {Rappture::objects::import $diff(-obj2) $diff(-path)} val2] == 0 && $val2 ne ""} {
629                set viewer [Rappture::objects::viewer $val2 \
630                    -for output -parent $viewarea]
631                if {$viewer ne ""} {
632                    if {$DiffShow ne ""} {
633                        if {[lindex $DiffShow 0] eq $viewer} {
634                            lappend DiffShow $val2
635                        } else {
636                            error "type mismatch between values: $diff(-obj1) vs $diff(-obj2) -- diff should have caught this as \"type\" difference"
637                        }
638                    } else {
639                        set DiffShow [list $viewer $val2]
640                    }
641                }
642                # try to get a string rep too
643                set status [$val2 export string str]
644                if {[lindex $status 0]} { set vstr2 $str }
645            }
646
647            if {$DiffShow ne ""} {
648                # we have a value viewer -- show the values in that
649                pack $viewer -expand yes -fill both
650
651                if {$val1 ne ""} {
652                    $viewer add $val1 [list -color black -description "Expected Result"]
653                }
654                if {$val2 ne ""} {
655                    $viewer add $val2 [list -color red -description "Test Result"]
656                }
657
658                # show the string diffs too
659                set w [.testdiffs.body.val2objs pane 1]
660                $w.obj configure -background $bg \
661                    -testobj $diff(-testobj) -path $diff(-path)
662
663                if {[info exists vstr1]} { set v1 $vstr1 } else { set v1 "" }
664                if {[info exists vstr2]} { set v2 $vstr2 } else { set v2 "" }
665                $w.diffs show $v1 $v2
666
667                set win .testdiffs.body.val2objs
668
669                set legsettings [list 2 normal \
670                    3 [expr {($val2 ne "") ? "normal" : "disabled"}] \
671                    4 [expr {($val1 ne "") ? "normal" : "disabled"}]]
672
673            } elseif {[info exists vstr1] && [info exists vstr2]} {
674                # we have two value strings -- show as a diff
675                set win .testdiffs.body.val2strs
676                $win.obj configure -background $bg \
677                    -testobj $diff(-testobj) -path $diff(-path)
678                $win.diffs show $vstr1 $vstr2
679                set legsettings {2 normal 3 disabled 4 disabled}
680            } elseif {[info exists vstr1] || [info exists vstr2]} {
681                # we have one value string -- show it
682                if {[info exists vstr1]} {
683                    set val $vstr1
684                } else {
685                    set val $vstr2
686                }
687                set win .testdiffs.body.val1str
688                $win.obj configure -background $bg \
689                    -testobj $diff(-testobj) -path $diff(-path)
690                $win.scrl.text configure -state normal
691                $win.scrl.text delete 1.0 end
692                $win.scrl.text insert end $val
693                $win.scrl.text configure -state disabled
694                set legsettings {2 disabled 3 disabled 4 disabled}
695            } else {
696                # don't have a value -- show the attributes
697                set win .testdiffs.body.val
698                $win.obj configure -background $bg \
699                    -testobj $diff(-testobj) -path $diff(-path)
700                set legsettings {2 disabled 3 disabled 4 disabled}
701            }
702
703            # clean up any objects that are not being stored
704            if {$val1 ne "" && [lsearch $DiffShow $val1] < 0} {
705                itcl::delete object $val1
706            }
707            if {$val2 ne "" && [lsearch $DiffShow $val2] < 0} {
708                itcl::delete object $val2
709            }
710        }
711        "attrs *" {
712            set win .testdiffs.body.attrs
713            set bg [lindex [$win configure -background] 3]
714            $win configure -testobj $diff(-testobj) -background $bg \
715                -path $diff(-path) -details max -showdiffs yes
716            set legsettings {2 disabled 3 disabled 4 disabled}
717        }
718        "status" {
719            set win .testdiffs.body.runs
720            $win configure -testobj $diff(-testobj) -showdiffs yes
721            set legsettings {2 disabled 3 disabled 4 disabled}
722        }
723        "type *" {
724            error "don't know how to show type diffs"
725            set legsettings {2 disabled 3 disabled 4 disabled}
726        }
727        "unkobj" {
728            set win .testdiffs.body.info
729            $win.text configure -state normal
730            $win.text delete 1.0 end
731            $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)]"
732            $win.text configure -state disabled
733            set legsettings {2 disabled 3 disabled 4 disabled}
734        }
735    }
736    if {[pack slaves .testdiffs.body] ne $win} {
737        foreach w [pack slaves .testdiffs.body] {
738            pack forget $w
739        }
740        pack $win -expand yes -fill both
741    }
742
743    # fix up the legend to best explain the current result
744    foreach {index state} $legsettings {
745        .testdiffs.legend itemconfigure $index -state $state
746    }
747
748    # pop up the viewer
749    place .testdiffs -x 0 -y 0 -anchor nw -relwidth 1 -relheight 1
750    raise .testdiffs
751}
752
753# ----------------------------------------------------------------------
754# USAGE: tester_diff_hide
755#
756# Takes down the panel posted by tester_diff_show.
757# ----------------------------------------------------------------------
758proc tester_diff_hide {} {
759    place forget .testdiffs
760}
761
762# ----------------------------------------------------------------------
763# USAGE: tester_regoldenize
764#
765# Regoldenizes the currently focused test case.  Displays a warning
766# message.  If confirmed, copy the test information from the existing
767# test xml into the new result, and write the new data into the test
768# xml.
769# ----------------------------------------------------------------------
770proc tester_regoldenize {} {
771    set testtree [.pw pane 0].tree
772    set seltests [$testtree curselection]
773
774    if {[llength $seltests] != 1} {
775        error "Oops! Multiple tests selected to regoldenize.  How did we get here?"
776    }
777
778    set test [lindex $seltests 0]
779    set testxml [$test getTestxml]
780    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?"]} {
781        $test regoldenize
782
783        # reload the updated description for this test
784        tester_selection_changed
785    }
786}
787
788wm deiconify .
Note: See TracBrowser for help on using the repository browser.