source: trunk/tester/compare.tcl @ 1965

Last change on this file since 1965 was 1965, checked in by braffert, 13 years ago

Developing regression tester

File size: 3.8 KB
Line 
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# ======================================================================
10package require Rappture
11
12namespace 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# ----------------------------------------------------------------------
22proc 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# ----------------------------------------------------------------------
38proc 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# ----------------------------------------------------------------------
62proc 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# ----------------------------------------------------------------------
76proc 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
Note: See TracBrowser for help on using the repository browser.