Home | History | Annotate | Download | only in tests 
      1 #! /usr/bin/perl
      2 ##--------------------------------------------------------------------##
      3 ##--- Valgrind regression testing script                vg_regtest ---##
      4 ##--------------------------------------------------------------------##
      5 
      6 #  This file is part of Valgrind, a dynamic binary instrumentation
      7 #  framework.
      8 #
      9 #  Copyright (C) 2003 Nicholas Nethercote
     10 #     njn (at] valgrind.org
     11 #
     12 #  This program is free software; you can redistribute it and/or
     13 #  modify it under the terms of the GNU General Public License as
     14 #  published by the Free Software Foundation; either version 2 of the
     15 #  License, or (at your option) any later version.
     16 #
     17 #  This program is distributed in the hope that it will be useful, but
     18 #  WITHOUT ANY WARRANTY; without even the implied warranty of
     19 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
     20 #  General Public License for more details.
     21 #
     22 #  You should have received a copy of the GNU General Public License
     23 #  along with this program; if not, write to the Free Software
     24 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
     25 #  02111-1307, USA.
     26 #
     27 #  The GNU General Public License is contained in the file COPYING.
     28 
     29 #----------------------------------------------------------------------------
     30 # usage: vg_regtest [options] <dirs | files>
     31 #
     32 # Options:
     33 #   --all:      run tests in all subdirs
     34 #   --valgrind: valgrind launcher to use.  Default is ./coregrind/valgrind.
     35 #               (This option should probably only be used in conjunction with
     36 #               --valgrind-lib.)
     37 #   --valgrind-lib: valgrind libraries to use.  Default is $tests_dir/.in_place.
     38 #               (This option should probably only be used in conjunction with
     39 #               --valgrind.)
     40 #
     41 # The easiest way is to run all tests in valgrind/ with (assuming you installed
     42 # in $PREFIX):
     43 #
     44 #   $PREFIX/bin/vg_regtest --all
     45 #
     46 # You can specify individual files to test, or whole directories, or both.
     47 # Directories are traversed recursively, except for ones named, for example, 
     48 # CVS/ or docs/.
     49 #
     50 # Each test is defined in a file <test>.vgtest, containing one or more of the
     51 # following lines, in any order:
     52 #   - prog:   <prog to run>                         (compulsory)
     53 #   - args:   <args for prog>                       (default: none)
     54 #   - vgopts: <Valgrind options>                    (default: none;
     55 #                                                    multiple are allowed)
     56 #   - stdout_filter: <filter to run stdout through> (default: none)
     57 #   - stderr_filter: <filter to run stderr through> (default: ./filter_stderr)
     58 #   - prereq: <prerequisite command>                (default: none)
     59 #   - post: <post-test check command>               (default: none)
     60 #   - cleanup: <post-test cleanup cmd>              (default: none)
     61 #
     62 # Note that filters are necessary for stderr results to filter out things that
     63 # always change, eg. process id numbers.
     64 #
     65 # Expected stdout (filtered) is kept in <test>.stdout.exp* (can be more
     66 # than one expected output).  It can be missing if it would be empty.  Expected
     67 # stderr (filtered) is kept in <test>.stderr.exp*.   There must be at least
     68 # one stderr.exp* file.  Any .exp* file that ends in '~' or '#' is ignored;
     69 # this is because Emacs creates temporary files of these names.
     70 #
     71 # If results don't match, the output can be found in <test>.std<strm>.out,
     72 # and the diff between expected and actual in <test>.std<strm>.diff*.
     73 #
     74 # The prerequisite command, if present, works like this:
     75 # - if it returns 0 the test is run
     76 # - if it returns 1 the test is skipped
     77 # - if it returns anything else the script aborts.
     78 # The idea here is results other than 0 or 1 are likely to be due to
     79 # problems with the commands, and you don't want to conflate them with the 1
     80 # case, which would happen if you just tested for zero or non-zero.
     81 #
     82 # The post-test command, if present, must return 0 and its stdout must match
     83 # the expected stdout which is kept in <test>.post.exp*.
     84 #
     85 # Sometimes it is useful to run all the tests at a high sanity check
     86 # level or with arbitrary other flags.  To make this simple, extra 
     87 # options, applied to all tests run, are read from $EXTRA_REGTEST_OPTS,
     88 # and handed to valgrind prior to any other flags specified by the 
     89 # .vgtest file.
     90 #
     91 # Some more notes on adding regression tests for a new tool are in
     92 # docs/xml/manual-writing-tools.xml.
     93 #----------------------------------------------------------------------------
     94 
     95 use warnings;
     96 use strict;
     97 
     98 #----------------------------------------------------------------------------
     99 # Global vars
    100 #----------------------------------------------------------------------------
    101 my $usage="\n"
    102           . "Usage:\n"
    103           . "   vg_regtest [--all, --valgrind, --valgrind-lib]\n"
    104           . "   Use EXTRA_REGTEST_OPTS to supply extra args for all tests\n"
    105           . "\n";
    106 
    107 my $tmp="vg_regtest.tmp.$$";
    108 
    109 # Test variables
    110 my $vgopts;             # valgrind options
    111 my $prog;               # test prog
    112 my $args;               # test prog args
    113 my $stdout_filter;      # filter program to run stdout results file through
    114 my $stderr_filter;      # filter program to run stderr results file through
    115 my $prereq;             # prerequisite test to satisfy before running test
    116 my $post;               # check command after running test
    117 my $cleanup;            # cleanup command to run
    118 
    119 my @failures;           # List of failed tests
    120 
    121 my $num_tests_done      = 0;
    122 my %num_failures        = (stderr => 0, stdout => 0, post => 0);
    123 
    124 # Default valgrind to use is this build tree's (uninstalled) one
    125 my $valgrind = "./coregrind/valgrind";
    126 
    127 chomp(my $tests_dir = `pwd`);
    128 
    129 my $valgrind_lib = "$tests_dir/.in_place";
    130 
    131 # default filter is the one named "filter_stderr" in the test's directory
    132 my $default_stderr_filter = "filter_stderr";
    133 
    134 
    135 #----------------------------------------------------------------------------
    136 # Process command line, setup
    137 #----------------------------------------------------------------------------
    138 
    139 # If $prog is a relative path, it prepends $dir to it.  Useful for two reasons:
    140 #
    141 # 1. Can prepend "." onto programs to avoid trouble with users who don't have
    142 #    "." in their path (by making $dir = ".")
    143 # 2. Can prepend the current dir to make the command absolute to avoid
    144 #    subsequent trouble when we change directories.
    145 #
    146 # Also checks the program exists and is executable.
    147 sub validate_program ($$$$) 
    148 {
    149     my ($dir, $prog, $must_exist, $must_be_executable) = @_;
    150 
    151     # If absolute path, leave it alone.  If relative, make it
    152     # absolute -- by prepending current dir -- so we can change
    153     # dirs and still use it.
    154     $prog = "$dir/$prog" if ($prog !~ /^\//);
    155     if ($must_exist) {
    156         (-f $prog) or die "vg_regtest: `$prog' not found or not a file ($dir)\n";
    157     }
    158     if ($must_be_executable) { 
    159         (-x $prog) or die "vg_regtest: `$prog' not executable ($dir)\n";
    160     }
    161 
    162     return $prog;
    163 }
    164 
    165 sub process_command_line() 
    166 {
    167     my $alldirs = 0;
    168     my @fs;
    169     
    170     for my $arg (@ARGV) {
    171         if ($arg =~ /^-/) {
    172             if      ($arg =~ /^--all$/) {
    173                 $alldirs = 1;
    174             } elsif ($arg =~ /^--valgrind=(.*)$/) {
    175                 $valgrind = $1;
    176             } elsif ($arg =~ /^--valgrind-lib=(.*)$/) {
    177                 $valgrind_lib = $1;
    178             } else {
    179                 die $usage;
    180             }
    181         } else {
    182             push(@fs, $arg);
    183         }
    184     }
    185     $valgrind = validate_program($tests_dir, $valgrind, 1, 0);
    186 
    187     if ($alldirs) {
    188         @fs = ();
    189         foreach my $f (glob "*") {
    190             push(@fs, $f) if (-d $f);
    191         }
    192     }
    193 
    194     (0 != @fs) or die "No test files or directories specified\n";
    195 
    196     return @fs;
    197 }
    198 
    199 #----------------------------------------------------------------------------
    200 # Read a .vgtest file
    201 #----------------------------------------------------------------------------
    202 sub read_vgtest_file($)
    203 {
    204     my ($f) = @_;
    205 
    206     # Defaults.
    207     ($vgopts, $prog, $args)          = ("", undef, "");
    208     ($stdout_filter, $stderr_filter) = (undef, undef);
    209     ($prereq, $post, $cleanup)       = (undef, undef, undef);
    210 
    211     # Every test directory must have a "filter_stderr"
    212     $stderr_filter = validate_program(".", $default_stderr_filter, 1, 1);
    213 
    214     open(INPUTFILE, "< $f") || die "File $f not openable\n";
    215 
    216     while (my $line = <INPUTFILE>) {
    217         if      ($line =~ /^\s*#/ || $line =~ /^\s*$/) {
    218 	    next;
    219 	} elsif ($line =~ /^\s*vgopts:\s*(.*)$/) {
    220             my $addvgopts = $1;
    221             $addvgopts =~ s/\${PWD}/$ENV{PWD}/g;
    222             $vgopts = $vgopts . " " . $addvgopts;   # Nb: Make sure there's a space!
    223         } elsif ($line =~ /^\s*prog:\s*(.*)$/) {
    224             $prog = validate_program(".", $1, 0, 0);
    225         } elsif ($line =~ /^\s*args:\s*(.*)$/) {
    226             $args = $1;
    227         } elsif ($line =~ /^\s*stdout_filter:\s*(.*)$/) {
    228             $stdout_filter = validate_program(".", $1, 1, 1);
    229         } elsif ($line =~ /^\s*stderr_filter:\s*(.*)$/) {
    230             $stderr_filter = validate_program(".", $1, 1, 1);
    231         } elsif ($line =~ /^\s*prereq:\s*(.*)$/) {
    232             $prereq = $1;
    233         } elsif ($line =~ /^\s*post:\s*(.*)$/) {
    234             $post = $1;
    235         } elsif ($line =~ /^\s*cleanup:\s*(.*)$/) {
    236             $cleanup = $1;
    237         } else {
    238             die "Bad line in $f: $line\n";
    239         }
    240     }
    241     close(INPUTFILE);
    242 
    243     if (!defined $prog) {
    244         $prog = "";     # allow no prog for testing error and --help cases
    245     }
    246 }
    247 
    248 #----------------------------------------------------------------------------
    249 # Do one test
    250 #----------------------------------------------------------------------------
    251 # Since most of the program time is spent in system() calls, need this to
    252 # propagate a Ctrl-C enabling us to quit.
    253 sub mysystem($) 
    254 {
    255     my $exit_code = system($_[0]);
    256     ($exit_code == 2) and exit 1;      # 2 is SIGINT
    257     return $exit_code;
    258 }
    259 
    260 # from a directory name like "/foo/cachesim/tests/" determine the tool name
    261 sub determine_tool()
    262 {
    263     my $dir = `pwd`;
    264     $dir =~ /.*\/([^\/]+)\/tests.*/;   # foo/tool_name/tests/foo
    265     return $1;
    266 }
    267 
    268 # Compare output against expected output;  it should match at least one of
    269 # them.
    270 sub do_diffs($$$$)
    271 {
    272     my ($fullname, $name, $mid, $f_exps) = @_;
    273     
    274     for my $f_exp (@$f_exps) {
    275         (-r $f_exp) or die "Could not read `$f_exp'\n";
    276 
    277         # Emacs produces temporary files that end in '~' and '#'.  We ignore
    278         # these.
    279         if ($f_exp !~ /[~#]$/) {
    280             # $n is the (optional) suffix after the ".exp";  we tack it onto
    281             # the ".diff" file.
    282             my $n = "";
    283             if ($f_exp =~ /.*\.exp(.*)$/) {
    284                 $n = $1;
    285             } else {
    286                 $n = "";
    287                 ($f_exp eq "/dev/null") or die "Unexpected .exp file: $f_exp\n";
    288             }
    289 
    290             mysystem("diff -u $f_exp $name.$mid.out > $name.$mid.diff$n");
    291 
    292             if (not -s "$name.$mid.diff$n") {
    293                 # A match;  remove .out and any previously created .diff files.
    294                 unlink("$name.$mid.out");
    295                 unlink(<$name.$mid.diff*>);
    296                 return;
    297             }
    298         }
    299     }
    300     # If we reach here, none of the .exp files matched.
    301     print "*** $name failed ($mid) ***\n";
    302     push(@failures, sprintf("%-40s ($mid)", "$fullname"));
    303     $num_failures{$mid}++;
    304 }
    305 
    306 sub do_one_test($$) 
    307 {
    308     my ($dir, $vgtest) = @_;
    309     $vgtest =~ /^(.*)\.vgtest/;
    310     my $name = $1;
    311     my $fullname = "$dir/$name"; 
    312 
    313     # Pull any extra options (for example, --sanity-level=4)
    314     # from $EXTRA_REGTEST_OPTS.
    315     my $maybe_extraopts = $ENV{"EXTRA_REGTEST_OPTS"};
    316     my $extraopts = $maybe_extraopts ?  $maybe_extraopts  : "";
    317 
    318     read_vgtest_file($vgtest);
    319 
    320     if (defined $prereq) {
    321         my $prereq_res = system("$prereq");
    322         if (0 == $prereq_res) {
    323             # Do nothing (ie. continue with the test)
    324         } elsif (256 == $prereq_res) {
    325             # Nb: weird Perl-ism -- exit code of '1' is seen by Perl as 256...
    326             # Prereq failed, skip.
    327             printf("%-16s (skipping, prereq failed: $prereq)\n", "$name:");
    328             return;
    329         } else {
    330             # Bad prereq; abort.
    331             $prereq_res /= 256;
    332             die "prereq returned $prereq_res: $prereq\n";
    333         }
    334     }
    335 
    336     printf("%-16s valgrind $extraopts $vgopts $prog $args\n", "$name:");
    337 
    338     # Pass the appropriate --tool option for the directory (can be overridden
    339     # by an "args:" line, though).  Set both VALGRIND_LIB and
    340     # VALGRIND_LIB_INNER in case this Valgrind was configured with
    341     # --enable-inner.
    342     my $tool=determine_tool();
    343     mysystem("VALGRIND_LIB=$valgrind_lib VALGRIND_LIB_INNER=$valgrind_lib "
    344            . "$valgrind --command-line-only=yes --memcheck:leak-check=no "
    345            . "--tool=$tool $extraopts $vgopts "
    346            . "$prog $args > $name.stdout.out 2> $name.stderr.out");
    347 
    348     # Filter stdout
    349     if (defined $stdout_filter) {
    350         mysystem("$stdout_filter < $name.stdout.out > $tmp");
    351         rename($tmp, "$name.stdout.out");
    352     }
    353     # Find all the .stdout.exp files.  If none, use /dev/null.
    354     my @stdout_exps = <$name.stdout.exp*>;
    355     @stdout_exps = ( "/dev/null" ) if (0 == scalar @stdout_exps);
    356     do_diffs($fullname, $name, "stdout", \@stdout_exps); 
    357 
    358     # Filter stderr
    359     mysystem("$stderr_filter < $name.stderr.out > $tmp");
    360     rename($tmp, "$name.stderr.out");
    361     # Find all the .stderr.exp files.  At least one must exist.
    362     my @stderr_exps = <$name.stderr.exp*>;
    363     (0 != scalar @stderr_exps) or die "Could not find `$name.stderr.exp*'\n";
    364     do_diffs($fullname, $name, "stderr", \@stderr_exps); 
    365 
    366     # Maybe do post-test check
    367     if (defined $post) {
    368 	if (mysystem("$post > $name.post.out") != 0) {
    369 	    print("post check failed: $post\n");
    370 	    $num_failures{"post"}++;
    371 	} else {
    372 	    # Find all the .post.exp files.  If none, use /dev/null.
    373 	    my @post_exps = <$name.post.exp*>;
    374 	    @post_exps = ( "/dev/null" ) if (0 == scalar @post_exps);
    375 	    do_diffs($fullname, $name, "post", \@post_exps);
    376 	}
    377     }
    378  
    379     if (defined $cleanup) {
    380         (system("$cleanup") == 0) or 
    381             print("(cleanup operation failed: $cleanup)\n");
    382     }
    383 
    384     $num_tests_done++;
    385 }
    386 
    387 #----------------------------------------------------------------------------
    388 # Test one directory (and any subdirs)
    389 #----------------------------------------------------------------------------
    390 sub test_one_dir($$);    # forward declaration
    391 
    392 sub test_one_dir($$) 
    393 {
    394     my ($dir, $prev_dirs) = @_;
    395     $dir =~ s/\/$//;    # trim a trailing '/'
    396 
    397     # Ignore dirs into which we should not recurse.
    398     if ($dir =~ /^(BitKeeper|CVS|SCCS|docs|doc)$/) { return; }
    399 
    400     (-x "$tests_dir/tests/arch_test") or die 
    401         "vg_regtest: 'arch_test' is missing.  Did you forget to 'make check'?\n";
    402     
    403     # Ignore any dir whose name matches that of an architecture which is not
    404     # the architecture we are running on.  Eg. when running on x86, ignore
    405     # ppc/ directories ('arch_test' returns 1 for this case).  Likewise for
    406     # the OS and platform.
    407     # Nb: weird Perl-ism -- exit code of '1' is seen by Perl as 256...
    408     if (256 == system("$tests_dir/tests/arch_test $dir"))  { return; }
    409     if (256 == system("$tests_dir/tests/os_test   $dir"))  { return; }
    410     if ($dir =~ /(\w+)-(\w+)/ &&
    411         256 == system("sh $tests_dir/tests/platform_test $1 $2")) { return; }
    412     
    413     chdir($dir) or die "Could not change into $dir\n";
    414 
    415     # Nb: Don't prepend a '/' to the base directory
    416     my $full_dir = $prev_dirs . ($prev_dirs eq "" ? "" : "/") . $dir;
    417     my $dashes = "-" x (50 - length $full_dir);
    418 
    419     my @fs = glob "*";
    420     my $found_tests = (0 != (grep { $_ =~ /\.vgtest$/ } @fs));
    421 
    422     if ($found_tests) {
    423         print "-- Running  tests in $full_dir $dashes\n";
    424     }
    425     foreach my $f (@fs) {
    426         if (-d $f) {
    427             test_one_dir($f, $full_dir);
    428         } elsif ($f =~ /\.vgtest$/) {
    429             do_one_test($full_dir, $f);
    430         }
    431     }
    432     if ($found_tests) {
    433         print "-- Finished tests in $full_dir $dashes\n";
    434     }
    435 
    436     chdir("..");
    437 }
    438 
    439 #----------------------------------------------------------------------------
    440 # Summarise results
    441 #----------------------------------------------------------------------------
    442 sub plural($)
    443 {
    444    return ( $_[0] == 1 ? "" : "s" );
    445 }
    446 
    447 sub summarise_results 
    448 {
    449     my $x = ( $num_tests_done == 1 ? "test" : "tests" );
    450     
    451     printf("\n== %d test%s, %d stderr failure%s, %d stdout failure%s, "
    452                          . "%d post failure%s ==\n", 
    453            $num_tests_done, plural($num_tests_done),
    454            $num_failures{"stderr"},   plural($num_failures{"stderr"}),
    455            $num_failures{"stdout"},   plural($num_failures{"stdout"}),
    456            $num_failures{"post"},     plural($num_failures{"post"}));
    457 
    458     foreach my $failure (@failures) {
    459         print "$failure\n";
    460     }
    461     print "\n";
    462 }
    463 
    464 #----------------------------------------------------------------------------
    465 # main(), sort of
    466 #----------------------------------------------------------------------------
    467 sub warn_about_EXTRA_REGTEST_OPTS()
    468 {
    469     print "WARNING: \$EXTRA_REGTEST_OPTS is set.  You probably don't want\n";
    470     print "to run the regression tests with it set, unless you are doing some\n";
    471     print "strange experiment, and/or you really know what you are doing.\n";
    472     print "\n";
    473 }
    474 
    475 # nuke VALGRIND_OPTS
    476 $ENV{"VALGRIND_OPTS"} = "";
    477 
    478 if ($ENV{"EXTRA_REGTEST_OPTS"}) {
    479     print "\n";
    480     warn_about_EXTRA_REGTEST_OPTS();
    481 }
    482 
    483 my @fs = process_command_line();
    484 foreach my $f (@fs) {
    485     if (-d $f) {
    486         test_one_dir($f, "");
    487     } else { 
    488         # Allow the .vgtest suffix to be given or omitted
    489         if ($f =~ /.vgtest$/ && -r $f) {
    490             # do nothing
    491         } elsif (-r "$f.vgtest") {
    492             $f = "$f.vgtest";
    493         } else {
    494             die "`$f' neither a directory nor a readable test file/name\n"
    495         }
    496         my $dir  = `dirname  $f`;   chomp $dir;
    497         my $file = `basename $f`;   chomp $file;
    498         chdir($dir) or die "Could not change into $dir\n";
    499         do_one_test($dir, $file);
    500         chdir($tests_dir);
    501     }
    502 }
    503 summarise_results();
    504 
    505 if ($ENV{"EXTRA_REGTEST_OPTS"}) {
    506     warn_about_EXTRA_REGTEST_OPTS();
    507 }
    508 
    509 if (0 == $num_failures{"stdout"} &&
    510     0 == $num_failures{"stderr"} &&
    511     0 == $num_failures{"post"}) {
    512     exit 0;
    513 } else {
    514     exit 1;
    515 }
    516 
    517 ##--------------------------------------------------------------------##
    518 ##--- end                                               vg_regtest ---##
    519 ##--------------------------------------------------------------------##
    520