1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
#!/usr/bin/env perl
use warnings;
use strict;
my ($results, $truth) = @ARGV;
my ($report, $pass, $fail) = compare_results("$results/results.dat", "$truth/results.dat");
open OUT, ">$results/Summary";
print OUT $report;
print $report;
close OUT;
if ($fail > 0) {
print <<EOT;
There were failures in this test run. Please analyze the results carefully.
EOT
exit 1;
}
exit 0;
sub compare_results {
my ($testf, $truthf) = @_;
my $test = read_results($testf);
my $truth = read_results($truthf);
my $ct1 = delete $truth->{'COMPARISON_TYPE'};
my $ct2 = delete $test->{'COMPARISON_TYPE'};
my $pass = 0;
my $fail = 0;
my $report = '';
foreach my $k (sort keys %$truth) {
$report .= "test-name=$k\tresult=";
if (!exists $test->{$k}) {
$report .= "missing from test results\n";
$fail++;
next;
}
my $truthv = $truth->{$k} || '';
my $testv = delete $test->{$k} || '';
if ($ct1->{$k} eq '=') {
if ($truthv eq $testv) {
$report .= "pass\n";
$pass++;
} else {
$report .= "fail\n\tTRUTH=$truthv\n\t TEST=$testv\n";
$fail++;
}
} else { # numeric difference
$testv=$testv?$testv:0;
$truthv=$truthv?$truthv:0;
my $diff = $testv - $truthv;
if ($diff == 0) { $report .= "identical\n"; next; }
$report .= "BASELINE=$truthv, TEST=$testv\t DELTA=$diff";
if ($truthv != 0) {
my $pct = $diff/$truthv;
my $t = sprintf "\t PCT CHANGE=%4.2f", $pct*100;
$report .= $t;
}
$report .= "\n";
}
}
foreach my $k (sort keys %$test) {
$fail++;
$report .= "test-name=$k\tfound in TEST but not in TRUTH.\n";
}
$report .= "\nTESTS PASSED=$pass\nTESTS FAILED=$fail\n";
return $report, $pass, $fail;
}
sub read_results {
my ($file) = @_;
open IN, "<$file" or die "Could not open $file!";
my %res;
while (my $l = <IN>) {
if ($l =~ /^([A-Za-z0-9_]+)\s*([=~])\s*(.+)$/) {
my ($key, $comparison_type, $value) = ($1, $2, $3);
$res{$key} = $value;
$res{'COMPARISON_TYPE'}->{$key}=$comparison_type;
}
}
close IN;
return \%res;
}
|
