Improve performtest.pl

Improve arguments and documentation of performtest.pl
Remove carriage returns in .stdout/.stderr so *nix can
read Windows test results

1 files changed, 89 insertions, 37 deletions

diff --git a/test/performtest.pl b/test/performtest.pl
index c66e27be..ab5b3ef9 100755
--- a/test/performtest.pl
+++ b/test/performtest.pl
@@ -1,31 +1,23 @@
 #!/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 usage {
-    print
-'Perform tests on nasm.
-
-Usage: performtest.pl ["quiet"] ["clean"] ["golden"] nasm_executable test_files...
-';
-    exit;
-}
-
-# sub debugprint { print (pop() . "\n"); }
-sub debugprint { }
-
-#Get one command line argument
-sub get_arg { shift @ARGV; }
+#sub debugprint { print (pop() . "\n"); }
+ sub debugprint { }
 
 #Process one testfile
 sub perform {
-    my ($clean, $golden, $nasm, $quiet, $testpath) = @_;
+    my ($clean, $diff, $golden, $nasm, $quiet, $testpath) = @_;
     my ($stdoutfile, $stderrfile) = (".stdout", ".stderr");
 
     my ($testname, $ignoredpath, $ignoredsuffix) = fileparse($testpath, ".asm");
@@ -65,7 +57,9 @@ sub perform {
         }
         unlink ("$stdoutfile", "$stderrfile"); #Just to be sure
 
-        if(! $golden) {
+        if($golden) {
+            print "Test $testname/$subname created.\n" unless $quiet;
+        } else {
             #Compare them with the golden files
             my $result = 0;
             my @failedfiles = ();
@@ -74,7 +68,11 @@ sub perform {
                     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/$_");
+                        $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/$_");
                     }
@@ -85,7 +83,7 @@ sub perform {
                         push @failedfiles, $_;
                     } elsif($temp == -1) {
                         #error
-                        print "Error in $testname/$subname with file $_\n";
+                        print "Can't compare at $testname/$subname file $_\n";
                         next TEST;
                     }
                 } elsif (-f "golden/$testname/$subname/$_") {
@@ -95,11 +93,18 @@ sub perform {
                 }
             }
 
-
             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 golden/$testname/$subname/$_ $outputdir/$testname/$subname/$_";
+                            print "\n";
+                        }
+                    }
+                }
             } else {
                 die "Impossible result";
             }
@@ -108,29 +113,76 @@ sub perform {
     close(TESTFILE);
 }
 
-
-my $arg;
 my $nasm;
 my $clean = 0;
+my $diff = 0;
 my $golden = 0;
-my $quiet = 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 (-x $nasm) {
+  warn "Warning: $nasm may not be executable. Expect problems.\n\n";
+  sleep 5;
+}
 
-$arg = get_arg() or usage();
+perform($clean, $diff, $golden, $nasm, ! $verbose, $_) foreach @ARGV;
 
 
-if($arg eq "quiet") {
-    $quiet = 1;
-    $arg = get_arg() or usage();
-}
-if($arg eq "clean") {
-    $clean = 1;
-    $arg = get_arg() or usage();
-}
-if ($arg eq "golden") {
-    $golden = 1;
-    $arg = get_arg() or usage();
-}
+__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.
 
-$nasm = $arg;
+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.
 
-perform($clean, $golden, $nasm, $quiet, $_) foreach @ARGV;
+=cut