nasm/test/performtest.pl

193 lines
6.3 KiB
Perl
Raw Normal View History

2008-04-23 21:02:26 +08:00
#!/usr/bin/perl
#Perform tests on nasm
2008-04-23 21:02:26 +08:00
use strict;
use warnings;
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
2008-04-23 21:02:26 +08:00
use File::Basename qw(fileparse);
use File::Compare qw(compare compare_text);
use File::Copy qw(move);
use File::Path qw(mkpath rmtree);
#sub debugprint { print (pop() . "\n"); }
sub debugprint { }
2008-04-23 21:02:26 +08:00
my $globalresult = 0;
2008-04-23 21:02:26 +08:00
#Process one testfile
sub perform {
my ($clean, $diff, $golden, $nasm, $quiet, $testpath) = @_;
my ($stdoutfile, $stderrfile) = ("stdout", "stderr");
2008-04-23 21:02:26 +08:00
my ($testname, $ignoredpath, $ignoredsuffix) = fileparse($testpath, ".asm");
debugprint $testname;
my $outputdir = $golden ? "golden" : "testresults";
mkdir "$outputdir" unless -d "$outputdir";
if ($clean) {
rmtree "$outputdir/$testname";
return;
}
if(-d "$outputdir/$testname") {
rmtree "$outputdir/$testname";
}
open(TESTFILE, '<', $testpath) or (warn "Can't open $testpath\n", return);
TEST:
while(<TESTFILE>) {
#See if there is a test case
last unless /Testname=(.*);\s*Arguments=(.*);\s*Files=(.*)/;
my ($subname, $arguments, $files) = ($1, $2, $3);
debugprint("$subname | $arguments | $files");
#Call nasm with this test case
system("$nasm $arguments $testpath > $stdoutfile 2> $stderrfile");
debugprint("$nasm $arguments $testpath > $stdoutfile 2> $stderrfile ----> $?");
#Move the output to the test dir
mkpath("$outputdir/$testname/$subname");
foreach(split / /,$files) {
if (-f $_) {
move($_, "$outputdir/$testname/$subname/$_") or die $!
}
}
unlink ("$stdoutfile", "$stderrfile"); #Just to be sure
if($golden) {
print "Test $testname/$subname created.\n" unless $quiet;
} else {
2008-04-23 21:02:26 +08:00
#Compare them with the golden files
my $result = 0;
my @failedfiles = ();
foreach(split / /, $files) {
if(-f "$outputdir/$testname/$subname/$_") {
my $temp;
if($_ eq $stdoutfile or $_ eq $stderrfile) {
#Compare stdout and stderr in text mode so line ending changes won't matter
$temp = compare_text("$outputdir/$testname/$subname/$_", "golden/$testname/$subname/$_",
sub { my ($a, $b) = @_;
$a =~ s/\r//g;
$b =~ s/\r//g;
$a ne $b; } );
2008-04-23 21:02:26 +08:00
} else {
$temp = compare("$outputdir/$testname/$subname/$_", "golden/$testname/$subname/$_");
}
if($temp == 1) {
#different
$result = 1;
$globalresult = 1;
2008-04-23 21:02:26 +08:00
push @failedfiles, $_;
} elsif($temp == -1) {
#error
print "Can't compare at $testname/$subname file $_\n";
2008-04-23 21:02:26 +08:00
next TEST;
}
} elsif (-f "golden/$testname/$subname/$_") {
#File exists in golden but not in output
$result = 1;
$globalresult = 1;
2008-04-23 21:02:26 +08:00
push @failedfiles, $_;
}
}
if($result == 0) {
print "Test $testname/$subname succeeded.\n" unless $quiet;
} elsif ($result == 1) {
print "Test $testname/$subname failed on @failedfiles.\n";
if($diff) {
for(@failedfiles) {
if($_ eq $stdoutfile or $_ eq $stderrfile) {
system "diff -u golden/$testname/$subname/$_ $outputdir/$testname/$subname/$_";
print "\n";
}
}
}
2008-04-23 21:02:26 +08:00
} else {
die "Impossible result";
}
}
}
close(TESTFILE);
}
my $nasm;
my $clean = 0;
my $diff = 0;
2008-04-23 21:02:26 +08:00
my $golden = 0;
my $help = 0;
my $verbose = 0;
GetOptions('clean' => \$clean,
'diff'=> \$diff,
'golden' => \$golden,
'help' => \$help,
'verbose' => \$verbose,
'nasm=s' => \$nasm
) or pod2usage();
pod2usage() if $help;
die "Please specify either --nasm or --clean. Use --help for help.\n"
unless $nasm or $clean;
die "Please specify the test files, e.g. *.asm\n" unless @ARGV;
2008-08-06 21:15:01 +08:00
unless (!defined $nasm or -x $nasm) {
warn "Warning: $nasm may not be executable. Expect problems.\n\n";
sleep 5;
}
2008-04-23 21:02:26 +08:00
perform($clean, $diff, $golden, $nasm, ! $verbose, $_) foreach @ARGV;
exit $globalresult;
2008-04-23 21:02:26 +08:00
__END__
=head1 NAME
performtest.pl - NASM regression tester based on golden files
=head1 SYNOPSIS
performtest.pl [options] [testfile.asm ...]
Runs NASM on the specified test files and compare the results
with "golden" output files.
Options:
--clean Clean up test results (or golden files with --golden)
--diff Execute diff when stdout or stderr don't match
--golden Create golden files
--help Get this help
--nasm=file Specify the file name for the NASM executable, e.g. ../nasm
--verbose Get more output
If --clean is not specified, --nasm is required.
testfile.asm ...:
One or more files that NASM should be tested with,
often *.asm in the test directory.
It should contain one or more option lines at the start,
in the following format:
;Testname=<testname>; Arguments=<arguments to nasm>; Files=<output files>
If no such lines are found at the start, the file is skipped.
testname should ideally describe the arguments, eg. unoptimized for -O0.
arguments can be an optimization level (-O), an output format (-f),
an output file specifier (-o) etc.
The output files should be a space seperated list of files that will
be checked for regressions. This should often be the output file
and the special files stdout and stderr.
2008-04-23 21:02:26 +08:00
Any mismatch could be a regression,
but it doesn't have to be. COFF files have a timestamp which
makes this method useless. ELF files have a comment section
with the current version of NASM, so they will change each version number.
2008-04-23 21:02:26 +08:00
=cut