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 | #\ |
---|
26 | exec tclsh "$0" $* |
---|
27 | # ---------------------------------------------------------------------- |
---|
28 | # wish executes everything from here on... |
---|
29 | |
---|
30 | # TODO: Won't need this once tied in with the rest of the package |
---|
31 | lappend auto_path [file dirname $argv0] |
---|
32 | |
---|
33 | package require Itk |
---|
34 | package require Rappture |
---|
35 | package require RapptureGUI |
---|
36 | |
---|
37 | Rappture::getopts argv params { |
---|
38 | value -tool "" |
---|
39 | value -testdir "" |
---|
40 | } |
---|
41 | |
---|
42 | # If tool.xml and test directory locations are not given, try to find them. |
---|
43 | if {$params(-tool) == ""} { |
---|
44 | if {[file isfile tool.xml]} { |
---|
45 | set params(-tool) tool.xml |
---|
46 | } elseif {[file isfile [file join rappture tool.xml]]} { |
---|
47 | set params(-tool) [file join rappture tool.xml] |
---|
48 | } else { |
---|
49 | puts "Cannot find tool.xml" |
---|
50 | exit 1 |
---|
51 | } |
---|
52 | } elseif {![file isfile $params(-tool)]} { |
---|
53 | puts "Tool \"$params(-tool)\" does not exist" |
---|
54 | exit 1 |
---|
55 | } |
---|
56 | |
---|
57 | if {$params(-testdir) == ""} { |
---|
58 | set tooldir [file dirname $params(-tool)] |
---|
59 | if {[file isdirectory [file join $tooldir tests]]} { |
---|
60 | set params(-testdir) [file join $tooldir tests] |
---|
61 | } elseif {[file isdirectory [file join [file dirname $tooldir] tests]]} { |
---|
62 | set params(-testdir) [file join [file dirname $tooldir] tests] |
---|
63 | } else { |
---|
64 | puts "Cannot find test directory" |
---|
65 | exit 1 |
---|
66 | } |
---|
67 | } elseif {![file isdirectory $params(-testdir)]} { |
---|
68 | puts "Test directory \"$params(-testdir)\" does not exist" |
---|
69 | exit 1 |
---|
70 | } |
---|
71 | |
---|
72 | # ---------------------------------------------------------------------- |
---|
73 | # INITIALIZE WINDOW |
---|
74 | # ---------------------------------------------------------------------- |
---|
75 | wm title . "Rappture Regression Tester" |
---|
76 | panedwindow .pw |
---|
77 | |
---|
78 | .pw add [Rappture::Tester::TestTree .tree \ |
---|
79 | -testdir $params(-testdir) \ |
---|
80 | -toolxml $params(-tool) \ |
---|
81 | -selectcommand Rappture::Tester::selectionHandler] |
---|
82 | |
---|
83 | .pw add [frame .right] |
---|
84 | Rappture::Tester::TestView .right.view |
---|
85 | button .right.regoldenize -text "Regoldenize" -state disabled \ |
---|
86 | -command Rappture::Tester::regoldenize |
---|
87 | pack .right.regoldenize -side bottom -anchor e |
---|
88 | pack .right.view -side bottom -expand yes -fill both |
---|
89 | |
---|
90 | pack .pw -expand yes -fill both |
---|
91 | |
---|
92 | set lastsel "" |
---|
93 | |
---|
94 | # TODO: Handle resizing better |
---|
95 | # TODO: Fix error that occurs only when you click and hold on a test |
---|
96 | # while the right hand side is empty. Adding lastsel check |
---|
97 | # removed the error, but tree selection still acts strange when |
---|
98 | # holding down the mouse button. selectionHandler actually gets |
---|
99 | # invoked twice, somehow leading to an event dispatch error. |
---|
100 | # If selectionHandler does NOT reconfigure the right side with the |
---|
101 | # selected test, then no error occurs. |
---|
102 | |
---|
103 | # ---------------------------------------------------------------------- |
---|
104 | # USAGE: selectionHandler ?-refresh? |
---|
105 | # |
---|
106 | # Used internally to communicate between the test tree and the right |
---|
107 | # hand side viewer. Upon selecting a new tree node, pass the focused |
---|
108 | # node's data to the right hand side. Use the -refresh option to force |
---|
109 | # the selected test to be re-displayed on the right side. |
---|
110 | # ---------------------------------------------------------------------- |
---|
111 | proc Rappture::Tester::selectionHandler {args} { |
---|
112 | global lastsel |
---|
113 | set test [.tree getTest] |
---|
114 | if {$test != $lastsel || [lsearch $args "-refresh"] != -1} { |
---|
115 | .right.view configure -test $test |
---|
116 | if {$test != "" && [$test hasRan] && [$test getResult] != "Error"} { |
---|
117 | .right.regoldenize configure -state normal |
---|
118 | } else { |
---|
119 | .right.regoldenize configure -state disabled |
---|
120 | } |
---|
121 | set lastsel $test |
---|
122 | } |
---|
123 | } |
---|
124 | |
---|
125 | # ---------------------------------------------------------------------- |
---|
126 | # USAGE: regoldenize |
---|
127 | # |
---|
128 | # Regoldenizes the currently focused test case. Displays a warning |
---|
129 | # message. If confirmed, copy the test information from the existing |
---|
130 | # test xml into the new result, and write the new data into the test |
---|
131 | # xml. |
---|
132 | # ---------------------------------------------------------------------- |
---|
133 | proc Rappture::Tester::regoldenize {} { |
---|
134 | set test [.tree getTest] |
---|
135 | set testxml [$test getTestxml] |
---|
136 | if {[tk_messageBox -type yesno -icon warning -message "Are you sure you want to regoldenize?\n$testxml will be overwritten."]} { |
---|
137 | $test regoldenize |
---|
138 | .tree refresh |
---|
139 | selectionHandler |
---|
140 | } |
---|
141 | } |
---|
142 | |
---|