1 | # ---------------------------------------------------------------------- |
---|
2 | # COMPONENT: compare - comparison procedures for regression testing |
---|
3 | # ====================================================================== |
---|
4 | # AUTHOR: Ben Rafferty, Purdue University |
---|
5 | # Copyright (c) 2010 Purdue Research Foundation |
---|
6 | # |
---|
7 | # See the file "license.terms" for information on usage and |
---|
8 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
9 | # ====================================================================== |
---|
10 | package require Rappture |
---|
11 | |
---|
12 | namespace eval Rappture::Regression { #forward declaration } |
---|
13 | |
---|
14 | # ---------------------------------------------------------------------- |
---|
15 | # USAGE: compare_elements lib1 lib2 path |
---|
16 | # |
---|
17 | # Compare data found in two library objects at the given path. Returns |
---|
18 | # 1 if match, 0 if no match. For now, just check if ascii identical. |
---|
19 | # Later, we can do something more sophisticated for different types of |
---|
20 | # elements. |
---|
21 | # ---------------------------------------------------------------------- |
---|
22 | proc Rappture::Regression::compare_elements {lib1 lib2 path} { |
---|
23 | set val1 [$lib1 get $path] |
---|
24 | set val2 [$lib2 get $path] |
---|
25 | return [expr {$val1} != {$val2}] |
---|
26 | } |
---|
27 | |
---|
28 | # ---------------------------------------------------------------------- |
---|
29 | # USAGE: compare lib1 lib2 ?path? |
---|
30 | # |
---|
31 | # Compares two library objects and returns a list of paths that do not |
---|
32 | # match. Paths are relative to lib1 (i.e. if a path exists in lib2 but |
---|
33 | # not lib1, it will not be included in the result. Result will contain |
---|
34 | # all differences that occur as descendants of an optional starting |
---|
35 | # path. If the path argument is not given, then only the output |
---|
36 | # sections will be compared. |
---|
37 | # ---------------------------------------------------------------------- |
---|
38 | proc Rappture::Regression::compare {lib1 lib2 {path output}} { |
---|
39 | set diffs [list] |
---|
40 | foreach child [$lib1 children $path] { |
---|
41 | foreach diff [compare $lib1 $lib2 $path.$child] { |
---|
42 | lappend diffs $diff |
---|
43 | } |
---|
44 | } |
---|
45 | if {[compare_elements $lib1 $lib2 $path]} { |
---|
46 | # Ignore output.time and output.user |
---|
47 | if {$path != "output.time" && $path != "output.user"} { |
---|
48 | lappend diffs $path |
---|
49 | } |
---|
50 | } |
---|
51 | return $diffs |
---|
52 | } |
---|
53 | |
---|
54 | # ---------------------------------------------------------------------- |
---|
55 | # USAGE: makeDriver tool.xml test.xml |
---|
56 | # |
---|
57 | # Builds and returns a driver library object to be used for running the |
---|
58 | # test specified by testxml. Copy current values from test xml into the |
---|
59 | # newly created driver. If any inputs are present in the new tool.xml |
---|
60 | # which do not exist in the test xml, use the default value. |
---|
61 | # ---------------------------------------------------------------------- |
---|
62 | proc Rappture::Regression::makeDriver {toolxml testxml} { |
---|
63 | # TODO: Test with various cases, especially with missing input elements |
---|
64 | set toolobj [Rappture::library $toolxml] |
---|
65 | set golden [Rappture::library $testxml] |
---|
66 | set driver [Rappture::library $toolxml] |
---|
67 | return [Rappture::Regression::merge $toolobj $golden $driver] |
---|
68 | } |
---|
69 | |
---|
70 | # ---------------------------------------------------------------------- |
---|
71 | # USAGE: merge toolobj golden driver ?path? |
---|
72 | # |
---|
73 | # Used to recursively build up a driver library object for running a |
---|
74 | # test. Should not be called directly - see makeDriver. |
---|
75 | # ---------------------------------------------------------------------- |
---|
76 | proc Rappture::Regression::merge {toolobj golden driver {path input}} { |
---|
77 | set clist [$toolobj children $path] |
---|
78 | foreach child $clist { |
---|
79 | set val [$golden get $path.$child.current] |
---|
80 | if {$val != ""} { |
---|
81 | $driver put $path.$child.current $val |
---|
82 | } else { |
---|
83 | set def [$toolobj get $path.$child.default] |
---|
84 | if {$def != ""} { |
---|
85 | $driver put $path.$child.current $def |
---|
86 | } |
---|
87 | } |
---|
88 | Rappture::Regression::merge $toolobj $golden $driver $path.$child |
---|
89 | } |
---|
90 | return $driver |
---|
91 | } |
---|
92 | |
---|
93 | |
---|