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 | #\ |
---|
26 | exec 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 |
---|
31 | wm withdraw . |
---|
32 | |
---|
33 | set testerdir [file dirname [file normalize [info script]]] |
---|
34 | lappend auto_path $testerdir |
---|
35 | |
---|
36 | package require Itk |
---|
37 | package require Img |
---|
38 | package require Rappture |
---|
39 | package require RapptureGUI |
---|
40 | |
---|
41 | option add *selectBackground #bfefff |
---|
42 | option add *Tooltip.background white |
---|
43 | option add *Editor.background white |
---|
44 | option add *Gauge.textBackground white |
---|
45 | option add *TemperatureGauge.textBackground white |
---|
46 | option add *Switch.textBackground white |
---|
47 | option add *Progress.barColor #ffffcc |
---|
48 | option add *Diffview.background white |
---|
49 | option add *Text.background white |
---|
50 | option add *Balloon.titleBackground #6666cc |
---|
51 | option add *Balloon.titleForeground white |
---|
52 | option add *Balloon*Label.font -*-helvetica-medium-r-normal-*-12-* |
---|
53 | option add *Balloon*Radiobutton.font -*-helvetica-medium-r-normal-*-12-* |
---|
54 | option add *Balloon*Checkbutton.font -*-helvetica-medium-r-normal-*-12-* |
---|
55 | option add *ResultSet.controlbarBackground #6666cc |
---|
56 | option add *ResultSet.controlbarForeground white |
---|
57 | option add *ResultSet.activeControlBackground #ccccff |
---|
58 | option add *ResultSet.activeControlForeground black |
---|
59 | option add *Radiodial.length 3i |
---|
60 | option add *BugReport*banner*foreground white |
---|
61 | option add *BugReport*banner*background #a9a9a9 |
---|
62 | option add *BugReport*banner*highlightBackground #a9a9a9 |
---|
63 | option add *BugReport*banner*font -*-helvetica-bold-r-normal-*-18-* |
---|
64 | |
---|
65 | option add *testdiffs.hd*background #666666 |
---|
66 | option add *testdiffs.hd*highlightBackground #666666 |
---|
67 | option add *testdiffs.hd*foreground white |
---|
68 | option add *testdiffs.hd.inner.highlightBackground #999999 |
---|
69 | option add *testdiffs.hd.inner*font {Arial -12 bold} |
---|
70 | option add *testdiffs.hd.inner*help.font {Arial -10 italic} |
---|
71 | option add *testdiffs.hd.inner*help.padX 2 |
---|
72 | option add *testdiffs.hd.inner*help.padY 2 |
---|
73 | option add *testdiffs.hd.inner*help.borderWidth 1 |
---|
74 | option add *testdiffs.hd.inner*help.relief flat |
---|
75 | option add *testdiffs.hd.inner*help.overRelief raised |
---|
76 | option add *testdiffs.legend*font {Arial -12} |
---|
77 | |
---|
78 | switch $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 |
---|
88 | Rappture::bugreport::install |
---|
89 | |
---|
90 | # fix the "grab" command to support a stack of grab windows |
---|
91 | Rappture::grab::init |
---|
92 | |
---|
93 | # bring in the Rappture object system |
---|
94 | Rappture::objects::init |
---|
95 | |
---|
96 | # add the local image directory onto the path |
---|
97 | Rappture::icon foo ;# forces auto-loading of Rappture::icon |
---|
98 | set Rappture::icon::iconpath [linsert $Rappture::icon::iconpath 0 [file join $testerdir images]] |
---|
99 | |
---|
100 | |
---|
101 | Rappture::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. |
---|
107 | if {$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 | |
---|
121 | if {$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 | |
---|
136 | set installdir [file dirname [file normalize $params(-tool)]] |
---|
137 | set xmlobj [Rappture::library $params(-tool)] |
---|
138 | set ToolObj [Rappture::Tool ::#auto $xmlobj $installdir] |
---|
139 | set DiffShow "" ;# used to track which diff objects are being displayed |
---|
140 | |
---|
141 | # ---------------------------------------------------------------------- |
---|
142 | # INITIALIZE WINDOW |
---|
143 | # ---------------------------------------------------------------------- |
---|
144 | wm title . "Rappture Regression Tester" |
---|
145 | wm geometry . 800x500 |
---|
146 | Rappture::Panes .pw -orientation horizontal -sashcursor sb_h_double_arrow |
---|
147 | pack .pw -expand yes -fill both |
---|
148 | |
---|
149 | set win [.pw pane 0] |
---|
150 | Rappture::Tester::TestTree $win.tree \ |
---|
151 | -selectcommand tester_selection_changed |
---|
152 | pack $win.tree -expand yes -fill both -padx 8 -pady 8 |
---|
153 | |
---|
154 | set win [.pw insert end -fraction 0.8] |
---|
155 | |
---|
156 | # Frame for viewing tests |
---|
157 | # ---------------------------------------------------------------------- |
---|
158 | frame $win.testview |
---|
159 | frame $win.testview.bbar |
---|
160 | pack $win.testview.bbar -side bottom -fill x -pady {8 0} |
---|
161 | button $win.testview.bbar.regoldenize -text "<< New golden standard" \ |
---|
162 | -state disabled -command tester_regoldenize |
---|
163 | pack $win.testview.bbar.regoldenize -side left |
---|
164 | Rappture::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 | |
---|
167 | pack $win.testview.bbar -side bottom -fill x |
---|
168 | |
---|
169 | Rappture::Tester::TestView $win.testview.overview \ |
---|
170 | -runcommand tester_run |
---|
171 | pack $win.testview.overview -side top -fill both -padx 8 -pady 8 |
---|
172 | |
---|
173 | frame $win.testview.details |
---|
174 | label $win.testview.details.heading -text "Differences:" |
---|
175 | pack $win.testview.details.heading -side top -anchor w |
---|
176 | Rappture::Scroller $win.testview.details.scrl \ |
---|
177 | -xscrollmode auto -yscrollmode auto |
---|
178 | pack $win.testview.details.scrl -expand yes -fill both |
---|
179 | Rappture::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 | # ---------------------------------------------------------------------- |
---|
185 | frame $win.testrun |
---|
186 | label $win.testrun.title -text "Output from test run:" -anchor w |
---|
187 | pack $win.testrun.title -side top -anchor w |
---|
188 | |
---|
189 | Rappture::Progress $win.testrun.progress |
---|
190 | button $win.testrun.abort -text "Abort" |
---|
191 | pack $win.testrun.abort -side bottom -pady {8 0} |
---|
192 | |
---|
193 | Rappture::Scroller $win.testrun.scrl -xscrollmode auto -yscrollmode auto |
---|
194 | pack $win.testrun.scrl -expand yes -fill both |
---|
195 | text $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 | # --------------------------------------------------------------------- |
---|
200 | frame .testdiffs -borderwidth 10 -relief flat |
---|
201 | |
---|
202 | # header at the top with info about the diff, help, and close button |
---|
203 | frame .testdiffs.hd -borderwidth 4 -relief flat |
---|
204 | pack .testdiffs.hd -side top -fill x |
---|
205 | frame .testdiffs.hd.inner -highlightthickness 1 -borderwidth 2 -relief flat |
---|
206 | pack .testdiffs.hd.inner -expand yes -fill both |
---|
207 | button .testdiffs.hd.inner.close -relief flat -overrelief raised \ |
---|
208 | -bitmap [Rappture::icon dismiss] -command tester_diff_hide |
---|
209 | pack .testdiffs.hd.inner.close -side right -padx 8 |
---|
210 | label .testdiffs.hd.inner.title -compound left -anchor w -padx 8 |
---|
211 | pack .testdiffs.hd.inner.title -side left |
---|
212 | button .testdiffs.hd.inner.help -anchor w -text "Help..." \ |
---|
213 | -command "::Rappture::Tooltip::tooltip show .testdiffs.hd.inner.help +10,0" |
---|
214 | pack .testdiffs.hd.inner.help -side left -padx 10 |
---|
215 | |
---|
216 | # show add/deleted styles at the bottom |
---|
217 | Rappture::Tester::Legend .testdiffs.legend |
---|
218 | pack .testdiffs.legend -side bottom -fill x |
---|
219 | frame .testdiffs.line -height 1 -background black |
---|
220 | pack .testdiffs.line -side bottom -fill x -pady {0 2} |
---|
221 | |
---|
222 | # diff viewer goes in this spot |
---|
223 | frame .testdiffs.body |
---|
224 | pack .testdiffs.body -expand yes -fill both -padx 10 -pady {20 10} |
---|
225 | |
---|
226 | # viewer for attribute diffs |
---|
227 | Rappture::Tester::ObjView .testdiffs.body.attrs |
---|
228 | |
---|
229 | # viewer for run status diffs |
---|
230 | Rappture::Tester::RunView .testdiffs.body.runs |
---|
231 | |
---|
232 | # viewer for value diffs where object is extra or missing |
---|
233 | frame .testdiffs.body.val |
---|
234 | Rappture::Tester::ObjView .testdiffs.body.val.obj -details max -showdiffs no |
---|
235 | pack .testdiffs.body.val.obj -expand yes -fill both |
---|
236 | |
---|
237 | # viewer for value diffs where we have just one string |
---|
238 | frame .testdiffs.body.val1str |
---|
239 | Rappture::Tester::ObjView .testdiffs.body.val1str.obj \ |
---|
240 | -details min -showdiffs no |
---|
241 | pack .testdiffs.body.val1str.obj -side top -fill x |
---|
242 | label .testdiffs.body.val1str.l -text "Value:" |
---|
243 | pack .testdiffs.body.val1str.l -anchor w -padx 10 -pady {10 0} |
---|
244 | Rappture::Scroller .testdiffs.body.val1str.scrl \ |
---|
245 | -xscrollmode auto -yscrollmode auto |
---|
246 | pack .testdiffs.body.val1str.scrl -expand yes -fill both -padx 10 -pady {0 10} |
---|
247 | text .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 |
---|
251 | frame .testdiffs.body.val2strs |
---|
252 | Rappture::Tester::ObjView .testdiffs.body.val2strs.obj \ |
---|
253 | -details min -showdiffs no |
---|
254 | pack .testdiffs.body.val2strs.obj -side top -fill x |
---|
255 | Rappture::Tester::StringDiffs .testdiffs.body.val2strs.diffs \ |
---|
256 | -title1 "Expected this:" -title2 "Got this:" |
---|
257 | pack .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 |
---|
260 | Rappture::Panes .testdiffs.body.val2objs -orientation horizontal -sashcursor sb_h_double_arrow |
---|
261 | |
---|
262 | # empty area for the object value viewer |
---|
263 | set win [.testdiffs.body.val2objs pane 0] |
---|
264 | frame $win.val |
---|
265 | pack $win.val -expand yes -fill both |
---|
266 | |
---|
267 | # show object details and diff on the right-hand side |
---|
268 | set win [.testdiffs.body.val2objs insert end -fraction 0.5] |
---|
269 | Rappture::Tester::ObjView $win.obj -details min -showdiffs no |
---|
270 | pack $win.obj -side top -fill x |
---|
271 | Rappture::Tester::StringDiffs $win.diffs \ |
---|
272 | -title1 "Expected this:" -title2 "Got this:" |
---|
273 | pack $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) |
---|
276 | Rappture::Scroller .testdiffs.body.info \ |
---|
277 | -xscrollmode auto -yscrollmode auto |
---|
278 | pack .testdiffs.body.info -expand yes -fill both -padx 10 -pady {0 10} |
---|
279 | text .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 | # ---------------------------------------------------------------------- |
---|
296 | set testtree [.pw pane 0].tree |
---|
297 | foreach 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 | # ---------------------------------------------------------------------- |
---|
317 | proc 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 | # ---------------------------------------------------------------------- |
---|
482 | proc 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 | # ---------------------------------------------------------------------- |
---|
504 | proc 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 | # ---------------------------------------------------------------------- |
---|
566 | proc 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 | # ---------------------------------------------------------------------- |
---|
758 | proc 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 | # ---------------------------------------------------------------------- |
---|
770 | proc 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 | |
---|
788 | wm deiconify . |
---|