#!/usr/bin/perl
my $html = 0; # set to 1 to output a nicely formatted HTML page
my $do_odg = 0; # execute the cdr2odg diff test
my $do_vg = 0; # execute the valgrind test (takes a while)
my $pass_colour = "11dd11";
my $fail_colour = "dd1111";
my $warn_colour = "e59800";
my $skip_colour = "9999dd";
sub DisplayCell {
my ( $bgColor, $text ) = @_;
print "
$text | \n";
}
sub DiffTest {
my ( $command, $command2, $command3, $file, $extension ) = @_;
my $result = "passed";
my $comment = "";
my $errPath = $file . ".$extension.err";
my $rawPath = $file . ".$extension";
my $newRawPath = $file . ".$extension.new";
my $diffPath = $file . ".$extension.diff";
`$command $file 1> $newRawPath 2>/dev/null`;
if ($command2) {
`mv $newRawPath $newRawPath.tmp`;
`$command2 $newRawPath.tmp 1> $newRawPath 2> /dev/null`;
`rm $newRawPath.tmp`;
}
if ($command3) {
`mv $newRawPath $newRawPath.tmp`;
`$command3 $newRawPath.tmp 1> $newRawPath 2> /dev/null`;
`rm $newRawPath.tmp`;
}
if ( $err ne "" ) {
$result = "fail";
}
else {
# remove the generated (empty) error file
`rm -f $errPath`;
# diff the stored raw data with the newly generated raw data
`diff -u --minimal -d $rawPath $newRawPath 1>$diffPath 2>$diffPath`;
$diff = `cat $diffPath | grep -v "No differences encountered"`;
if ( $diff ne "" ) {
$result = "changed";
}
else {
`rm -f $diffPath`;
}
}
# remove the generated raw file
`rm -f $newRawPath`;
# DISPLAYING RESULTS
if ($html) {
my $bgColor;
if ( $diff eq "" && $err eq "" ) {
$bgColor = $pass_colour;
}
elsif ( $err ne "" ) {
$bgColor = $fail_colour;
}
else {
$bgColor = $warn_colour;
}
if ( $err ne "" || $diff ne "" ) {
$comment =
" "
. ( $err ne "" ? "error" : "diff" ) . "";
}
DisplayCell( $bgColor, $result . $comment );
}
else {
if ( $err ne "" || $diff ne "" ) {
$comment = ( $err ne "" ? "(error: " : "(diff: " )
. ( $err ne "" ? $errPath : $diffPath ) . ")";
}
print "! $file diff (using $command): $result $comment\n";
}
return $result;
}
sub CgTest {
my ( $command, $file ) = @_;
my $callgraph = `$command $file`;
chomp($callgraph);
return $callgraph;
}
sub RegTest {
my $rawDiffFailures = 0;
my $xhtmlDiffFailures = 0;
my $odgDiffFailures = 0;
my $vgFailures = 0;
my $callGraphFailures = 0;
my $vgCommand = "valgrind --tool=memcheck -v --track-origins=yes";
my $vgVersionOutput = `valgrind --version`;
if ( $vgVersionOutput =~ /\-2.1/
|| $vgVersionOutput =~ /\-2.2/ )
{
$vgCommand = "valgrind --tool=memcheck -v --track-origins=yes";
}
my @cdrVersionList = (
"1", "2", "3", "4", "5", "6", "7", "8", "8b", "9",
"10", "11", "12", "13", "14", "15", "16", "17", "18",
"19", "20", "21", "22", "23"
);
my $cdrVersion;
foreach $cdrVersion (@cdrVersionList) {
if ($html) {
print "Regression testing the CDR"
. $cdrVersion
. " parser
\n";
print "\n";
print "\n";
print "File | \n";
print "Raw Diff Test (cdr2raw) | \n";
print "XHTML Diff Test (cdr2xhtml) | \n";
print "Call Graph Test (cdr2raw) | \n";
print "ODG Test (cdr2odg) | \n";
print "Valgrind Test (cdr2raw) | \n";
print "ODG Valgrind Test (cdr2odg) | \n";
print "
\n";
}
else {
print "Regression testing the CDR" . $cdrVersion . " parser\n";
}
my $regrInput = 'testset/' . $cdrVersion . '/regression.in';
my @fileList = split( /\n/, `cat $regrInput` );
foreach $file (@fileList) {
my $filePath = 'testset/' . $cdrVersion . '/' . $file;
if ($html) {
print "\n";
print ""
. $file
. " | \n";
}
# /////////////////////
# DIFF REGRESSION TESTS
# /////////////////////
if ( DiffTest( "cdr2raw", 0, 0, $filePath, "raw" ) eq "fail" ) {
$rawDiffFailures++;
}
if (
DiffTest(
"cdr2xhtml", "xmllint --c14n --nonet --dropdtd",
"xmllint --format", $filePath,
"xhtml"
) eq "fail"
)
{
$xhtmlDiffFailures++;
}
if ($do_odg) {
if (
DiffTest(
"cdr2odg --stdout",
"xmllint --c14n",
"xmllint --format",
$filePath,
"odg"
) eq "fail"
)
{
$odgDiffFailures++;
}
}
else {
if ($html) {
DisplayCell( $skip_colour, "skipped" );
}
else {
print "! $file ODG: skipped\n";
}
}
# //////////////////////////
# CALL GRAPH REGRESSION TEST
# //////////////////////////
my $cgResult = CgTest( "cdr2raw --callgraph", $filePath );
if ( $cgResult ne "0" ) {
$callGraphFailures++;
}
if ($html) {
(
$cgResult eq "0"
? DisplayCell( $pass_colour, "passed" )
: DisplayCell( $fail_colour, "failed" )
);
}
else {
print "! $file call graph: "
. ( $cgResult eq "0" ? "passed" : "failed" ) . "\n";
}
# ////////////////////////
# VALGRIND REGRESSION TEST
# ////////////////////////
if ($do_vg) {
$vgPath = 'testset/' . $cdrVersion . '/' . $file . '.vg';
$valgrind = 0;
`$vgCommand --leak-check=yes cdr2raw $filePath 1> $vgPath 2> $vgPath`;
open VG, "$vgPath";
my $vgOutput;
while () {
if (/^\=\=/) {
$vgOutput .= $_;
if ( /definitely lost: [1-9]/
|| /ERROR SUMMARY: [1-9]/
|| /Invalid read of/ )
{
$valgrind = 1;
}
}
}
close VG;
`rm -f $vgPath`;
if ($valgrind) {
open VG, ">$vgPath";
print VG $vgOutput;
close VG;
$vgFailures++;
}
$vgOutput = "";
if ($html) {
(
$valgrind eq 0
? DisplayCell( $pass_colour, "passed" )
: DisplayCell(
$fail_colour, "failed log"
)
);
}
else {
print "! $file valgrind (using cdr2raw): "
. ( $valgrind eq "0" ? "passed" : "failed" ) . "\n";
}
}
else {
if ($html) {
DisplayCell( $skip_colour, "skipped" );
}
else {
print "! $file valgrind (using cdr2raw): skipped\n";
}
}
if ( $do_vg && $do_odg ) {
$vgPath = 'testset/' . $cdrVersion . '/' . $file . '.odgvg';
$odgvalgrind = 0;
`$vgCommand --leak-check=yes cdr2odg --stdout $filePath 1> $vgPath 2> $vgPath`;
open VG, "$vgPath";
my $vgOutput;
while () {
if (/^\=\=/) {
$vgOutput .= $_;
if ( /definitely lost: [1-9]/
|| /ERROR SUMMARY: [1-9]/
|| /Invalid read of/ )
{
$odgvalgrind = 1;
}
}
}
close VG;
`rm -f $vgPath`;
if ($odgvalgrind) {
open VG, ">$vgPath";
print VG $vgOutput;
close VG;
$odgvgFailures++;
}
$vgOutput = "";
if ($html) {
(
$odgvalgrind eq 0
? DisplayCell( $pass_colour, "passed" )
: DisplayCell(
$fail_colour, "failed log"
)
);
print "
\n";
}
else {
print "! $file odg valgrind: "
. ( $odgvalgrind eq "0" ? "passed" : "failed" ) . "\n";
}
}
else {
if ($html) {
DisplayCell( $skip_colour, "skipped" );
}
else {
print "! $file odg valgrind: skipped\n";
}
}
}
if ($html) {
print "
\n";
}
if ($html) {
print "Summary
\n";
print "Regression test found "
. $rawDiffFailures
. " raw diff failure(s)
\n";
print "Regression test found "
. $xhtmlDiffFailures
. " xhtml diff failure(s)
\n";
print "Regression test found "
. $callGraphFailures
. " call graph failure(s)
\n";
if ($do_odg) {
print "Regression test found "
. $odgDiffFailures
. " odg diff failure(s)
\n";
}
else {
print "ODG diff test skipped
\n";
}
if ($do_vg) {
print "Regression test found "
. $vgFailures
. " valgrind failure(s)
\n";
}
else {
print "Valgrind test skipped
\n";
}
}
else {
print "\nSummary\n";
print "Regression test found "
. $rawDiffFailures
. " raw diff failure(s)\n";
print "Regression test found "
. $xhtmlDiffFailures
. " xhtml diff failure(s)\n";
print "Regression test found "
. $callGraphFailures
. " call graph failure(s)\n";
if ($do_vg) {
print "Regression test found "
. $vgFailures
. " valgrind failure(s)\n";
}
else {
print "Valgrind test skipped\n";
}
if ($do_vg && $do_odg) {
print "Regression test found "
. $odgvgFailures
. "ODG valgrind failure(s)\n";
}
else {
print "ODG valgrind test skipped\n";
}
}
}
}
sub HtmlHeader {
print "\n\n\n\n";
print "libcdr Regression Test Suite
\n";
}
sub HtmlFooter {
print "\n\n";
}
my $confused = 0;
while ( scalar(@ARGV) > 0 ) {
my $argument = shift @ARGV;
if ( $argument =~ /--output-html/ ) {
$html = 1;
}
elsif ( $argument =~ /--vg/ ) {
$do_vg = 1;
}
elsif ( $argument =~ /--odg/ ) {
$do_odg = 1;
}
else {
$confused = 1;
}
}
if ($confused) {
print "Usage: regression.pl [ --output-html ] [ --vg ] [ --odg ]\n";
exit;
}
# Main function
if ($html) {
&HtmlHeader;
}
&RegTest;
if ($html) {
&HtmlFooter;
}