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