#!/usr/bin/env perl # $Id$ use warnings; use strict; my ($results, $truth) = @ARGV; my ($report, $pass, $fail) = compare_results("$results/results.txt", "$truth/results.txt"); open OUT, ">$results/Summary"; print OUT $report; print $report; close OUT; if ($fail > 0) { print <{'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 = (defined($truth->{$k}))?$truth->{$k}:''; my $testv = ''; if (defined($test->{$k})){ $testv = $test->{$k}; 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 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 = ) { 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; }