diff options
Diffstat (limited to 'test/performtest.pl')
| -rwxr-xr-x | test/performtest.pl | 192 |
1 files changed, 192 insertions, 0 deletions
diff --git a/test/performtest.pl b/test/performtest.pl new file mode 100755 index 0000000..f7865b3 --- /dev/null +++ b/test/performtest.pl @@ -0,0 +1,192 @@ +#!/usr/bin/perl +#Perform tests on nasm + +use strict; +use warnings; + +use Getopt::Long qw(GetOptions); +use Pod::Usage qw(pod2usage); + +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 { } + +my $globalresult = 0; + +#Process one testfile +sub perform { + my ($clean, $diff, $golden, $nasm, $quiet, $testpath) = @_; + my ($stdoutfile, $stderrfile) = ("stdout", "stderr"); + + 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 { + #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; } ); + } else { + $temp = compare("$outputdir/$testname/$subname/$_", "golden/$testname/$subname/$_"); + } + + if($temp == 1) { + #different + $result = 1; + $globalresult = 1; + push @failedfiles, $_; + } elsif($temp == -1) { + #error + print "Can't compare at $testname/$subname file $_\n"; + next TEST; + } + } elsif (-f "golden/$testname/$subname/$_") { + #File exists in golden but not in output + $result = 1; + $globalresult = 1; + 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"; + } + } + } + } else { + die "Impossible result"; + } + } + } + close(TESTFILE); +} + +my $nasm; +my $clean = 0; +my $diff = 0; +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; + +unless (!defined $nasm or -x $nasm) { + warn "Warning: $nasm may not be executable. Expect problems.\n\n"; + sleep 5; +} + +perform($clean, $diff, $golden, $nasm, ! $verbose, $_) foreach @ARGV; +exit $globalresult; + +__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. + +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. + +=cut |