test/performtest.pl

   1 #!/usr/bin/perl
   2 #Perform tests on nasm
   3
   4 use strict;
   5 use warnings;
   6
   7 use Getopt::Long qw(GetOptions);
   8 use Pod::Usage qw(pod2usage);
   9
  10 use File::Basename qw(fileparse);
  11 use File::Compare qw(compare compare_text);
  12 use File::Copy qw(move);
  13 use File::Path qw(mkpath rmtree);
  14
  15 #sub debugprint { print (pop() . "\n"); }
  16  sub debugprint { }
  17
  18 #Process one testfile
  19 sub perform {
  20     my ($clean, $diff, $golden, $nasm, $quiet, $testpath) = @_;
  21     my ($stdoutfile, $stderrfile) = ("stdout", "stderr");
  22
  23     my ($testname, $ignoredpath, $ignoredsuffix) = fileparse($testpath, ".asm");
  24     debugprint $testname;
  25
  26     my $outputdir = $golden ? "golden" : "testresults";
  27
  28     mkdir "$outputdir" unless -d "$outputdir";
  29
  30     if ($clean) {
  31         rmtree "$outputdir/$testname";
  32         return;
  33     }
  34
  35     if(-d "$outputdir/$testname") {
  36         rmtree "$outputdir/$testname";
  37     }
  38
  39     open(TESTFILE, '<', $testpath) or (warn "Can't open $testpath\n", return);
  40     TEST:
  41     while(<TESTFILE>) {
  42         #See if there is a test case
  43         last unless /Testname=(.*);\s*Arguments=(.*);\s*Files=(.*)/;
  44         my ($subname, $arguments, $files) = ($1, $2, $3);
  45         debugprint("$subname | $arguments | $files");
  46
  47         #Call nasm with this test case
  48         system("$nasm $arguments $testpath > $stdoutfile 2> $stderrfile");
  49         debugprint("$nasm $arguments $testpath > $stdoutfile 2> $stderrfile ----> $?");
  50
  51         #Move the output to the test dir
  52         mkpath("$outputdir/$testname/$subname");
  53         foreach(split / /,$files) {
  54             if (-f $_) {
  55                 move($_, "$outputdir/$testname/$subname/$_") or die $!
  56             }
  57         }
  58         unlink ("$stdoutfile", "$stderrfile"); #Just to be sure
  59
  60         if($golden) {
  61             print "Test $testname/$subname created.\n" unless $quiet;
  62         } else {
  63             #Compare them with the golden files
  64             my $result = 0;
  65             my @failedfiles = ();
  66             foreach(split / /, $files) {
  67                 if(-f "$outputdir/$testname/$subname/$_") {
  68                     my $temp;
  69                     if($_ eq $stdoutfile or $_ eq $stderrfile) {
  70                         #Compare stdout and stderr in text mode so line ending changes won't matter
  71                         $temp = compare_text("$outputdir/$testname/$subname/$_", "golden/$testname/$subname/$_",
  72                                              sub { my ($a, $b) = @_;
  73                                                    $a =~ s/\r//g;
  74                                                    $b =~ s/\r//g;
  75                                                    $a ne $b; } );
  76                     } else {
  77                         $temp = compare("$outputdir/$testname/$subname/$_", "golden/$testname/$subname/$_");
  78                     }
  79
  80                     if($temp == 1) {
  81                         #different
  82                         $result = 1;
  83                         push @failedfiles, $_;
  84                     } elsif($temp == -1) {
  85                         #error
  86                         print "Can't compare at $testname/$subname file $_\n";
  87                         next TEST;
  88                     }
  89                 } elsif (-f "golden/$testname/$subname/$_") {
  90                     #File exists in golden but not in output
  91                     $result = 1;
  92                     push @failedfiles, $_;
  93                 }
  94             }
  95
  96             if($result == 0) {
  97                 print "Test $testname/$subname succeeded.\n" unless $quiet;
  98             } elsif ($result == 1) {
  99                 print "Test $testname/$subname failed on @failedfiles.\n";
 100                 if($diff) {
 101                     for(@failedfiles) {
 102                         if($_ eq $stdoutfile or $_ eq $stderrfile) {
 103                             system "diff -u golden/$testname/$subname/$_ $outputdir/$testname/$subname/$_";
 104                             print "\n";
 105                         }
 106                     }
 107                 }
 108             } else {
 109                 die "Impossible result";
 110             }
 111         }
 112     }
 113     close(TESTFILE);
 114 }
 115
 116 my $nasm;
 117 my $clean = 0;
 118 my $diff = 0;
 119 my $golden = 0;
 120 my $help = 0;
 121 my $verbose = 0;
 122
 123 GetOptions('clean' => \$clean,
 124            'diff'=> \$diff,
 125            'golden' => \$golden,
 126            'help' => \$help,
 127            'verbose' => \$verbose,
 128            'nasm=s' => \$nasm
 129           ) or pod2usage();
 130
 131 pod2usage() if $help;
 132 die "Please specify either --nasm or --clean. Use --help for help.\n"
 133 unless $nasm or $clean;
 134 die "Please specify the test files, e.g. *.asm\n" unless @ARGV;
 135
 136 unless (!defined $nasm or -x $nasm) {
 137   warn "Warning: $nasm may not be executable. Expect problems.\n\n";
 138   sleep 5;
 139 }
 140
 141 perform($clean, $diff, $golden, $nasm, ! $verbose, $_) foreach @ARGV;
 142
 143
 144 __END__
 145
 146 =head1 NAME
 147
 148 performtest.pl - NASM regression tester based on golden files
 149
 150 =head1 SYNOPSIS
 151
 152 performtest.pl [options] [testfile.asm ...]
 153
 154 Runs NASM on the specified test files and compare the results
 155 with "golden" output files.
 156
 157  Options:
 158      --clean     Clean up test results (or golden files with --golden)
 159      --diff      Execute diff when stdout or stderr don't match
 160      --golden    Create golden files
 161      --help      Get this help
 162      --nasm=file Specify the file name for the NASM executable, e.g. ../nasm
 163      --verbose   Get more output
 164
 165      If --clean is not specified, --nasm is required.
 166
 167  testfile.asm ...:
 168     One or more files that NASM should be tested with,
 169     often *.asm in the test directory.
 170     It should contain one or more option lines at the start,
 171     in the following format:
 172
 173 ;Testname=<testname>; Arguments=<arguments to nasm>; Files=<output files>
 174
 175     If no such lines are found at the start, the file is skipped.
 176     testname should ideally describe the arguments, eg. unoptimized for -O0.
 177     arguments can be an optimization level (-O), an output format (-f),
 178     an output file specifier (-o) etc.
 179     The output files should be a space seperated list of files that will
 180     be checked for regressions. This should often be the output file
 181     and the special files stdout and stderr.
 182
 183 Any mismatch could be a regression,
 184 but it doesn't have to be. COFF files have a timestamp which
 185 makes this method useless. ELF files have a comment section
 186 with the current version of NASM, so they will change each version number.
 187
 188 =cut