Home | History | Annotate | Download | only in tests
      1 #! @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-2017 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 #   --keep-unfiltered: keep a copy of the unfiltered output/error output
     41 #     of each test by adding an extension .unfiltered.out
     42 #
     43 #   --outer-valgrind: run this valgrind under the given outer valgrind.
     44 #     This valgrind must be configured with --enable-inner.
     45 #   --outer-tool: tool to use by the outer valgrind (default memcheck).
     46 #   --outer-args: use this as outer tool args. If the outer args are starting
     47 #      with +, the given outer args are appended to the outer args predefined
     48 #      by vg_regtest.
     49 #   --loop-till-fail: loops on the test(s) till one fail, then exit
     50 #              This is useful to obtain detailed trace or --keep-unfiltered
     51 #              output of a non deterministic test failure
     52 #
     53 # The easiest way is to run all tests in valgrind/ with (assuming you installed
     54 # in $PREFIX):
     55 #
     56 #   $PREFIX/bin/vg_regtest --all
     57 #
     58 # You can specify individual files to test, or whole directories, or both.
     59 # Directories are traversed recursively, except for ones named, for example, 
     60 # CVS/ or docs/.
     61 #
     62 # Each test is defined in a file <test>.vgtest, containing one or more of the
     63 # following lines, in any order:
     64 #   - prog:   <prog to run>
     65 #   - prog-asis: <prog to run>
     66 #   - env: <environment variable for prog>          (default: none)
     67 #   - args:   <args for prog>                       (default: none)
     68 #   - vgopts: <Valgrind options>                    (default: none;
     69 #                                                    multiple are allowed)
     70 #   - stdout_filter: <filter to run stdout through> (default: none)
     71 #   - stderr_filter: <filter to run stderr through> (default: ./filter_stderr)
     72 #   - stdout_filter_args: <args for stdout_filter>  (default: basename of .vgtest file)
     73 #   - stderr_filter_args: <args for stderr_filter>  (default: basename of .vgtest file)
     74 #
     75 #   - progB:  <prog to run in parallel with prog>   (default: none)
     76 #   - envB: <environment variable for progB>        (default: none)
     77 #   - argsB:  <args for progB>                      (default: none)
     78 #   - stdinB: <input file for progB>                (default: none)
     79 #   - stdoutB_filter: <filter progB stdout through> (default: none)
     80 #   - stderrB_filter: <filter progB stderr through> (default: ./filter_stderr)
     81 #   - stdoutB_filter_args: <args for stdout_filterB> (default: basename of .vgtest file)
     82 #   - stderrB_filter_args: <args for stderr_filterB>  (default: basename of .vgtest file)
     83 #
     84 #   - prereq: <prerequisite command>                (default: none)
     85 #   - post: <post-test check command>               (default: none)
     86 #   - cleanup: <post-test cleanup cmd>              (default: none)
     87 #
     88 # One of prog or prog-asis must be specified.
     89 # If prog or probB is a relative path, it will be prefix with the test directory.
     90 # prog-asis will be taken as is, i.e. not prefixed with the test directory.
     91 # Note that filters are necessary for stderr results to filter out things that
     92 # always change, eg. process id numbers.
     93 # Note that if a progB is specified, it is started in background (before prog).
     94 #
     95 # There can be more than one env: declaration. Here is an example:
     96 #   env: PATH=/opt/bin:$PATH
     97 # Likewise for envB.
     98 #
     99 # Expected stdout (filtered) is kept in <test>.stdout.exp* (can be more
    100 # than one expected output).  It can be missing if it would be empty.  Expected
    101 # stderr (filtered) is kept in <test>.stderr.exp*.   There must be at least
    102 # one stderr.exp* file.  Any .exp* file that ends in '~' or '#' is ignored;
    103 # this is because Emacs creates temporary files of these names.
    104 #
    105 # Expected output for progB is handled similarly, except that
    106 # expected stdout and stderr for progB are in  <test>.stdoutB.exp*
    107 # and <test>.stderrB.exp*.
    108 #
    109 # If results don't match, the output can be found in <test>.std<strm>.out,
    110 # and the diff between expected and actual in <test>.std<strm>.diff*.
    111 # (for progB, in <test>.std<strm>2.out and <test>.std<strm>2.diff*).
    112 #
    113 # The prerequisite command, if present, works like this:
    114 # - if it returns 0 the test is run
    115 # - if it returns 1 the test is skipped
    116 # - if it returns anything else the script aborts.
    117 # The idea here is results other than 0 or 1 are likely to be due to
    118 # problems with the commands, and you don't want to conflate them with the 1
    119 # case, which would happen if you just tested for zero or non-zero.
    120 #
    121 # The post-test command, if present, must return 0 and its stdout must match
    122 # the expected stdout which is kept in <test>.post.exp*.
    123 #
    124 # Sometimes it is useful to run all the tests at a high sanity check
    125 # level or with arbitrary other flags.  To make this simple, extra 
    126 # options, applied to all tests run, are read from $EXTRA_REGTEST_OPTS,
    127 # and handed to valgrind prior to any other flags specified by the 
    128 # .vgtest file.
    129 #
    130 # Some more notes on adding regression tests for a new tool are in
    131 # docs/xml/manual-writing-tools.xml.
    132 #----------------------------------------------------------------------------
    133 
    134 use warnings;
    135 use strict;
    136 
    137 #----------------------------------------------------------------------------
    138 # Global vars
    139 #----------------------------------------------------------------------------
    140 my $usage="\n"
    141      . "Usage:\n"
    142      . "   vg_regtest [--all, --valgrind, --valgrind-lib, --keep-unfiltered\n"
    143      . "                 --outer-valgrind, --outer-tool, --outer-args\n"
    144      . "                 --loop-till-fail]\n"
    145      . "   Use EXTRA_REGTEST_OPTS to supply extra args for all tests\n"
    146      . "\n";
    147 
    148 my $tmp="vg_regtest.tmp.$$";
    149 
    150 # Test variables
    151 my $vgopts;             # valgrind options
    152 my $prog;               # test prog
    153 my $args;               # test prog args
    154 my $stdout_filter;      # filter program to run stdout results file through
    155 my $stderr_filter;      # filter program to run stderr results file through
    156 my $stdout_filter_args; # arguments passed to stdout_filter
    157 my $stderr_filter_args; # arguments passed to stderr_filter
    158 my $progB;              # Same but for progB
    159 my $argsB;              # 
    160 my $stdoutB_filter;     # 
    161 my $stderrB_filter;     # 
    162 my $stdoutB_filter_args;# arguments passed to stdout_filterB
    163 my $stderrB_filter_args;# arguments passed to stderr_filterB
    164 my $stdinB;             # Input file for progB
    165 my $prereq;             # prerequisite test to satisfy before running test
    166 my $post;               # check command after running test
    167 my $cleanup;            # cleanup command to run
    168 my @env = ();           # environment variable to set prior calling $prog
    169 my @envB = ();          # environment variable to set prior calling $progB
    170 
    171 my @failures;           # List of failed tests
    172 
    173 my $num_tests_done      = 0;
    174 my %num_failures        = (stderr => 0, stdout => 0, 
    175                            stderrB => 0, stdoutB => 0,
    176                            post => 0);
    177 
    178 # Default valgrind to use is this build tree's (uninstalled) one
    179 my $valgrind = "./coregrind/valgrind";
    180 
    181 chomp(my $tests_dir = `pwd`);
    182 
    183 # Outer valgrind to use, and args to use for it.
    184 my $outer_valgrind;
    185 my $outer_tool = "memcheck";
    186 my $outer_args;
    187 my $run_outer_args = "";
    188 
    189 my $valgrind_lib = "$tests_dir/.in_place";
    190 my $keepunfiltered = 0;
    191 my $looptillfail = 0;
    192 
    193 # default filter is the one named "filter_stderr" in the test's directory
    194 my $default_stderr_filter = "filter_stderr";
    195 
    196 
    197 #----------------------------------------------------------------------------
    198 # Process command line, setup
    199 #----------------------------------------------------------------------------
    200 
    201 # If $prog is a relative path, it prepends $dir to it.  Useful for two reasons:
    202 #
    203 # 1. Can prepend "." onto programs to avoid trouble with users who don't have
    204 #    "." in their path (by making $dir = ".")
    205 # 2. Can prepend the current dir to make the command absolute to avoid
    206 #    subsequent trouble when we change directories.
    207 #
    208 # Also checks the program exists and is executable.
    209 sub validate_program ($$$$) 
    210 {
    211     my ($dir, $prog, $must_exist, $must_be_executable) = @_;
    212 
    213     # If absolute path, leave it alone.  If relative, make it
    214     # absolute -- by prepending current dir -- so we can change
    215     # dirs and still use it.
    216     $prog = "$dir/$prog" if ($prog !~ /^\//);
    217     if ($must_exist) {
    218         (-f $prog) or die "vg_regtest: `$prog' not found or not a file ($dir)\n";
    219     }
    220     if ($must_be_executable) { 
    221         (-x $prog) or die "vg_regtest: `$prog' not executable ($dir)\n";
    222     }
    223 
    224     return $prog;
    225 }
    226 
    227 sub process_command_line() 
    228 {
    229     my $alldirs = 0;
    230     my @fs;
    231     
    232     for my $arg (@ARGV) {
    233         if ($arg =~ /^-/) {
    234             if      ($arg =~ /^--all$/) {
    235                 $alldirs = 1;
    236             } elsif ($arg =~ /^--valgrind=(.*)$/) {
    237                 $valgrind = $1;
    238             } elsif ($arg =~ /^--outer-valgrind=(.*)$/) {
    239                 $outer_valgrind = $1;
    240             } elsif ($arg =~ /^--outer-tool=(.*)$/) {
    241                 $outer_tool = $1;
    242             } elsif ($arg =~ /^--outer-args=(.*)$/) {
    243                 $outer_args = $1;
    244             } elsif ($arg =~ /^--valgrind-lib=(.*)$/) {
    245                 $valgrind_lib = $1;
    246             } elsif ($arg =~ /^--keep-unfiltered$/) {
    247                 $keepunfiltered = 1;
    248             } elsif ($arg =~ /^--loop-till-fail$/) {
    249                 $looptillfail = 1;
    250             } else {
    251                 die $usage;
    252             }
    253         } else {
    254             push(@fs, $arg);
    255         }
    256     }
    257     $valgrind = validate_program($tests_dir, $valgrind, 1, 0);
    258     
    259     if (defined $outer_valgrind) {
    260       $outer_valgrind = validate_program($tests_dir, $outer_valgrind, 1, 1);
    261       if ((not defined $outer_args)  || ($outer_args =~ /^\+/)) {
    262           $run_outer_args = 
    263                 " --command-line-only=yes"
    264               . " --run-libc-freeres=no --sim-hints=enable-outer"
    265               . " --smc-check=all-non-file"
    266               . " --vgdb=no --trace-children=yes --read-var-info=no"
    267               . " --read-inline-info=yes"
    268               . " --suppressions=" 
    269               . validate_program($tests_dir,"./tests/outer_inner.supp",1,0)
    270               . " --memcheck:leak-check=full --memcheck:show-reachable=no"
    271               . " --num-callers=40"
    272               . " ";
    273               # we use a (relatively) big --num-callers, to allow the outer to report
    274               # also the inner guest stack trace, when reporting an error.
    275           if (defined $outer_args) {
    276              $outer_args =~ s/^\+(.*)/$1/;
    277              $run_outer_args = $run_outer_args . $outer_args;
    278           }
    279       } else {
    280           $run_outer_args = $outer_args;
    281       }
    282     }
    283 
    284     if ($alldirs) {
    285         @fs = ();
    286         foreach my $f (glob "*") {
    287             push(@fs, $f) if (-d $f);
    288         }
    289     }
    290 
    291     (0 != @fs) or die "No test files or directories specified\n";
    292 
    293     return @fs;
    294 }
    295 
    296 #----------------------------------------------------------------------------
    297 # Read a .vgtest file
    298 #----------------------------------------------------------------------------
    299 sub read_vgtest_file($)
    300 {
    301     my ($f) = @_;
    302 
    303     # Defaults.
    304     ($vgopts, $prog, $args)            = ("", undef, "");
    305     ($stdout_filter, $stderr_filter)   = (undef, undef);
    306     ($progB, $argsB, $stdinB)          = (undef, "", undef);
    307     ($stdoutB_filter, $stderrB_filter) = (undef, undef);
    308     ($prereq, $post, $cleanup)         = (undef, undef, undef);
    309     ($stdout_filter_args, $stderr_filter_args)   = (undef, undef);
    310     ($stdoutB_filter_args, $stderrB_filter_args) = (undef, undef);
    311 
    312     # Every test directory must have a "filter_stderr"
    313     $stderr_filter = validate_program(".", $default_stderr_filter, 1, 1);
    314     $stderrB_filter = validate_program(".", $default_stderr_filter, 1, 1);
    315     
    316 
    317     open(INPUTFILE, "< $f") || die "File $f not openable\n";
    318 
    319     while (my $line = <INPUTFILE>) {
    320         if      ($line =~ /^\s*#/ || $line =~ /^\s*$/) {
    321 	    next;
    322 	} elsif ($line =~ /^\s*vgopts:\s*(.*)$/) {
    323             my $addvgopts = $1;
    324             $addvgopts =~ s/\$\{PWD\}/$ENV{PWD}/g;
    325             $vgopts = $vgopts . " " . $addvgopts;   # Nb: Make sure there's a space!
    326         } elsif ($line =~ /^\s*prog:\s*(.*)$/) {
    327             $prog = validate_program(".", $1, 0, 0);
    328         } elsif ($line =~ /^\s*prog-asis:\s*(.*)$/) {
    329             $prog = $1;
    330         } elsif ($line =~ /^\s*args:\s*(.*)$/) {
    331             $args = $1;
    332         } elsif ($line =~ /^\s*stdout_filter:\s*(.*)$/) {
    333             $stdout_filter = validate_program(".", $1, 1, 1);
    334         } elsif ($line =~ /^\s*stderr_filter:\s*(.*)$/) {
    335             $stderr_filter = validate_program(".", $1, 1, 1);
    336         } elsif ($line =~ /^\s*stdout_filter_args:\s*(.*)$/) {
    337             $stdout_filter_args = $1;
    338         } elsif ($line =~ /^\s*stderr_filter_args:\s*(.*)$/) {
    339             $stderr_filter_args = $1;
    340         } elsif ($line =~ /^\s*progB:\s*(.*)$/) {
    341             $progB = validate_program(".", $1, 0, 0);
    342         } elsif ($line =~ /^\s*argsB:\s*(.*)$/) {
    343             $argsB = $1;
    344         } elsif ($line =~ /^\s*stdinB:\s*(.*)$/) {
    345             $stdinB = $1;
    346         } elsif ($line =~ /^\s*stdoutB_filter:\s*(.*)$/) {
    347             $stdoutB_filter = validate_program(".", $1, 1, 1);
    348         } elsif ($line =~ /^\s*stderrB_filter:\s*(.*)$/) {
    349             $stderrB_filter = validate_program(".", $1, 1, 1);
    350         } elsif ($line =~ /^\s*stdoutB_filter_args:\s*(.*)$/) {
    351             $stdoutB_filter_args = $1;
    352         } elsif ($line =~ /^\s*stderrB_filter_args:\s*(.*)$/) {
    353             $stderrB_filter_args = $1;
    354         } elsif ($line =~ /^\s*prereq:\s*(.*)$/) {
    355             $prereq = $1;
    356         } elsif ($line =~ /^\s*post:\s*(.*)$/) {
    357             $post = $1;
    358         } elsif ($line =~ /^\s*cleanup:\s*(.*)$/) {
    359             $cleanup = $1;
    360         } elsif ($line =~ /^\s*env:\s*(.*)$/) {
    361             push @env,$1;
    362         } elsif ($line =~ /^\s*envB:\s*(.*)$/) {
    363             push @envB,$1;
    364         } else {
    365             die "Bad line in $f: $line\n";
    366         }
    367     }
    368     close(INPUTFILE);
    369 
    370     if (!defined $prog) {
    371         $prog = "";     # allow no prog for testing error and --help cases
    372     }
    373 }
    374 
    375 #----------------------------------------------------------------------------
    376 # Do one test
    377 #----------------------------------------------------------------------------
    378 # Since most of the program time is spent in system() calls, need this to
    379 # propagate a Ctrl-C enabling us to quit.
    380 sub mysystem($) 
    381 {
    382     my $exit_code = system($_[0]);
    383     ($exit_code == 2) and exit 1;      # 2 is SIGINT
    384     return $exit_code;
    385 }
    386 
    387 # if $keepunfiltered, copies $1 to $1.unfiltered.out
    388 # renames $0 tp $1
    389 sub filtered_rename($$) 
    390 {
    391     if ($keepunfiltered == 1) {
    392         mysystem("cp  $_[1] $_[1].unfiltered.out");
    393     }
    394     rename ($_[0], $_[1]);
    395 }
    396 
    397 
    398 # from a directory name like "/foo/cachesim/tests/" determine the tool name
    399 sub determine_tool()
    400 {
    401     my $dir = `pwd`;
    402     $dir =~ /.*\/([^\/]+)\/tests.*/;   # foo/tool_name/tests/foo
    403     return $1;
    404 }
    405 
    406 # Compare output against expected output;  it should match at least one of
    407 # them.
    408 sub do_diffs($$$$)
    409 {
    410     my ($fullname, $name, $mid, $f_exps) = @_;
    411     
    412     for my $f_exp (@$f_exps) {
    413         (-r $f_exp) or die "Could not read `$f_exp'\n";
    414 
    415         # Emacs produces temporary files that end in '~' and '#'.  We ignore
    416         # these.
    417         if ($f_exp !~ /[~#]$/) {
    418             # $n is the (optional) suffix after the ".exp";  we tack it onto
    419             # the ".diff" file.
    420             my $n = "";
    421             if ($f_exp =~ /.*\.exp(.*)$/) {
    422                 $n = $1;
    423             } else {
    424                 $n = "";
    425                 ($f_exp eq "/dev/null") or die "Unexpected .exp file: $f_exp\n";
    426             }
    427 
    428             mysystem("@DIFF@ $f_exp $name.$mid.out > $name.$mid.diff$n");
    429 
    430             if (not -s "$name.$mid.diff$n") {
    431                 # A match;  remove .out and any previously created .diff files.
    432                 unlink("$name.$mid.out");
    433                 unlink(<$name.$mid.diff*>);
    434                 return;
    435             }
    436         }
    437     }
    438     # If we reach here, none of the .exp files matched.
    439     print "*** $name failed ($mid) ***\n";
    440     push(@failures, sprintf("%-40s ($mid)", "$fullname"));
    441     $num_failures{$mid}++;
    442     if ($looptillfail == 1) {
    443        print "Failure encountered, stopping to loop\n";
    444        exit 1
    445     }
    446 }
    447 
    448 sub do_one_test($$) 
    449 {
    450     my ($dir, $vgtest) = @_;
    451     $vgtest =~ /^(.*)\.vgtest/;
    452     my $name = $1;
    453     my $fullname = "$dir/$name"; 
    454 
    455     # Pull any extra options (for example, --sanity-level=4)
    456     # from $EXTRA_REGTEST_OPTS.
    457     my $maybe_extraopts = $ENV{"EXTRA_REGTEST_OPTS"};
    458     my $extraopts = $maybe_extraopts ?  $maybe_extraopts  : "";
    459 
    460     read_vgtest_file($vgtest);
    461 
    462     if (defined $prereq) {
    463         my $prereq_res = system("/bin/sh", "-c", $prereq);
    464         if (0 == $prereq_res) {
    465             # Do nothing (ie. continue with the test)
    466         } elsif (256 == $prereq_res) {
    467             # Nb: weird Perl-ism -- exit code of '1' is seen by Perl as 256...
    468             # Prereq failed, skip.
    469             printf("%-16s (skipping, prereq failed: $prereq)\n", "$name:");
    470             return;
    471         } else {
    472             # Bad prereq; abort.
    473             $prereq_res /= 256;
    474             die "prereq returned $prereq_res: $prereq\n";
    475         }
    476     }
    477 
    478 
    479     if (defined $progB) {
    480         # Collect environment variables, if any.
    481         my $envBvars = "";
    482         foreach my $e (@envB) {
    483            $envBvars = "$envBvars $e";
    484         }
    485         # If there is a progB, let's start it in background:
    486         printf("%-16s valgrind $extraopts $vgopts $prog $args (progB: $progB $argsB)\n",
    487                "$name:");
    488         # progB.done used to detect child has finished. See below.
    489         # Note: redirection of stdout and stderr is before $progB to allow argsB
    490         # to e.g. redirect stdoutB to stderrB
    491         if (defined $stdinB) {
    492             mysystem("(rm -f progB.done;"
    493                      . " < $stdinB > $name.stdoutB.out 2> $name.stderrB.out"
    494                      . " $envBvars $progB $argsB;"
    495                      . "touch progB.done) &");
    496         } else {
    497             mysystem("(rm -f progB.done;"
    498                      . " > $name.stdoutB.out 2> $name.stderrB.out"
    499                      . "$envBvars $progB $argsB;"
    500                      . "touch progB.done)  &");
    501         }
    502     } else {
    503         printf("%-16s valgrind $extraopts $vgopts $prog $args\n", "$name:");
    504     }
    505 
    506     # Collect environment variables, if any.
    507     my $envvars = "";
    508     foreach my $e (@env) {
    509         $envvars = "$envvars $e";
    510     }
    511 
    512     # Pass the appropriate --tool option for the directory (can be overridden
    513     # by an "args:" line, though).
    514     my $tool=determine_tool();
    515     if (defined $outer_valgrind ) {
    516         # in an outer-inner setup, only set VALGRIND_LIB_INNER
    517         mysystem(   "$envvars VALGRIND_LIB_INNER=$valgrind_lib "
    518                   . "$outer_valgrind "
    519                   . "--tool=" . $outer_tool . " "
    520                   . "--log-file=" . "$name.outer.log "
    521                   . "$run_outer_args "
    522                   . "$valgrind --command-line-only=yes --memcheck:leak-check=no "
    523                   . "--sim-hints=no-inner-prefix "
    524                   . "--tool=$tool $extraopts $vgopts "
    525                   . "$prog $args > $name.stdout.out 2> $name.stderr.out");
    526     } else {
    527         # Set both VALGRIND_LIB and VALGRIND_LIB_INNER in case this Valgrind
    528         # was configured with --enable-inner.
    529         mysystem(   "$envvars VALGRIND_LIB=$valgrind_lib VALGRIND_LIB_INNER=$valgrind_lib "
    530                   . "$valgrind --command-line-only=yes --memcheck:leak-check=no "
    531                   . "--tool=$tool $extraopts $vgopts "
    532                   . "$prog $args > $name.stdout.out 2> $name.stderr.out");
    533     }
    534 
    535     # Filter stdout
    536     if (defined $stdout_filter) {
    537         $stdout_filter_args = $name if (! defined $stdout_filter_args);
    538         mysystem("$stdout_filter $stdout_filter_args < $name.stdout.out > $tmp");
    539         filtered_rename($tmp, "$name.stdout.out");
    540     }
    541     # Find all the .stdout.exp files.  If none, use /dev/null.
    542     my @stdout_exps = <$name.stdout.exp*>;
    543     @stdout_exps = ( "/dev/null" ) if (0 == scalar @stdout_exps);
    544     do_diffs($fullname, $name, "stdout", \@stdout_exps); 
    545 
    546     # Filter stderr
    547     $stderr_filter_args = $name if (! defined $stderr_filter_args);
    548     mysystem("$stderr_filter $stderr_filter_args < $name.stderr.out > $tmp");
    549     filtered_rename($tmp, "$name.stderr.out");
    550     # Find all the .stderr.exp files.  At least one must exist.
    551     my @stderr_exps = <$name.stderr.exp*>;
    552     (0 != scalar @stderr_exps) or die "Could not find `$name.stderr.exp*'\n";
    553     do_diffs($fullname, $name, "stderr", \@stderr_exps); 
    554 
    555     if (defined $progB) {
    556         # wait for the child to be finished
    557         # tried things such as:
    558         #   wait;
    559         #   $SIG{CHLD} = sub { wait };
    560         # but nothing worked:
    561         # e.g. running mssnapshot.vgtest in a loop failed from time to time
    562         # due to some missing output (not yet written?).
    563         # So, we search progB.done during max 100 times 100 millisecond.
    564         my $count;
    565         for ($count = 1; $count <= 100; $count++) {
    566             (-f "progB.done") or select(undef, undef, undef, 0.100);
    567         }
    568         # Filter stdout
    569         if (defined $stdoutB_filter) {
    570             $stdoutB_filter_args = $name if (! defined $stdoutB_filter_args);
    571             mysystem("$stdoutB_filter $stdoutB_filter_args < $name.stdoutB.out > $tmp");
    572             filtered_rename($tmp, "$name.stdoutB.out");
    573         }
    574         # Find all the .stdoutB.exp files.  If none, use /dev/null.
    575         my @stdoutB_exps = <$name.stdoutB.exp*>;
    576         @stdoutB_exps = ( "/dev/null" ) if (0 == scalar @stdoutB_exps);
    577         do_diffs($fullname, $name, "stdoutB", \@stdoutB_exps); 
    578         
    579         # Filter stderr
    580         $stderrB_filter_args = $name if (! defined $stderrB_filter_args);
    581         mysystem("$stderrB_filter $stderrB_filter_args < $name.stderrB.out > $tmp");
    582         filtered_rename($tmp, "$name.stderrB.out");
    583         # Find all the .stderrB.exp files.  At least one must exist.
    584         my @stderrB_exps = <$name.stderrB.exp*>;
    585         (0 != scalar @stderrB_exps) or die "Could not find `$name.stderrB.exp*'\n";
    586         do_diffs($fullname, $name, "stderrB", \@stderrB_exps); 
    587     }
    588 
    589     # Maybe do post-test check
    590     if (defined $post) {
    591 	if (mysystem("$post > $name.post.out") != 0) {
    592 	    print("post check failed: $post\n");
    593 	    $num_failures{"post"}++;
    594 	} else {
    595 	    # Find all the .post.exp files.  If none, use /dev/null.
    596 	    my @post_exps = <$name.post.exp*>;
    597 	    @post_exps = ( "/dev/null" ) if (0 == scalar @post_exps);
    598 	    do_diffs($fullname, $name, "post", \@post_exps);
    599 	}
    600     }
    601  
    602     if (defined $cleanup) {
    603         (system("$cleanup") == 0) or 
    604             print("(cleanup operation failed: $cleanup)\n");
    605     }
    606 
    607     $num_tests_done++;
    608 }
    609 
    610 #----------------------------------------------------------------------------
    611 # Test one directory (and any subdirs)
    612 #----------------------------------------------------------------------------
    613 sub test_one_dir($$);    # forward declaration
    614 
    615 sub test_one_dir($$) 
    616 {
    617     my ($dir, $prev_dirs) = @_;
    618     $dir =~ s/\/$//;    # trim a trailing '/'
    619 
    620     # Ignore dirs into which we should not recurse.
    621     if ($dir =~ /^(BitKeeper|CVS|SCCS|docs|doc)$/) { return; }
    622 
    623     (-x "$tests_dir/tests/arch_test") or die 
    624         "vg_regtest: 'arch_test' is missing.  Did you forget to 'make check'?\n";
    625     
    626     # Ignore any dir whose name matches that of an architecture which is not
    627     # the architecture we are running on.  Eg. when running on x86, ignore
    628     # ppc/ directories ('arch_test' returns 1 for this case).  Likewise for
    629     # the OS and platform.
    630     # Nb: weird Perl-ism -- exit code of '1' is seen by Perl as 256...
    631     if (256 == system("$tests_dir/tests/arch_test $dir"))  { return; }
    632     if (256 == system("$tests_dir/tests/os_test   $dir"))  { return; }
    633     if ($dir =~ /(\w+)-(\w+)/ &&
    634         256 == system("sh $tests_dir/tests/platform_test $1 $2")) { return; }
    635     
    636     chdir($dir) or die "Could not change into $dir\n";
    637 
    638     # Nb: Don't prepend a '/' to the base directory
    639     my $full_dir = $prev_dirs . ($prev_dirs eq "" ? "" : "/") . $dir;
    640     my $dashes = "-" x (50 - length $full_dir);
    641 
    642     my @fs = glob "*";
    643     my $found_tests = (0 != (grep { $_ =~ /\.vgtest$/ } @fs));
    644 
    645     if ($found_tests) {
    646         print "-- Running  tests in $full_dir $dashes\n";
    647     }
    648     foreach my $f (@fs) {
    649         if (-d $f) {
    650             test_one_dir($f, $full_dir);
    651         } elsif ($f =~ /\.vgtest$/) {
    652             do_one_test($full_dir, $f);
    653         }
    654     }
    655     if ($found_tests) {
    656         print "-- Finished tests in $full_dir $dashes\n";
    657     }
    658 
    659     chdir("..");
    660 }
    661 
    662 #----------------------------------------------------------------------------
    663 # Summarise results
    664 #----------------------------------------------------------------------------
    665 sub plural($)
    666 {
    667    return ( $_[0] == 1 ? "" : "s" );
    668 }
    669 
    670 sub summarise_results 
    671 {
    672     my $x = ( $num_tests_done == 1 ? "test" : "tests" );
    673     
    674     printf("\n== %d test%s, %d stderr failure%s, %d stdout failure%s, "
    675                          . "%d stderrB failure%s, %d stdoutB failure%s, "
    676                          . "%d post failure%s ==\n", 
    677            $num_tests_done, plural($num_tests_done),
    678            $num_failures{"stderr"},   plural($num_failures{"stderr"}),
    679            $num_failures{"stdout"},   plural($num_failures{"stdout"}),
    680            $num_failures{"stderrB"},  plural($num_failures{"stderrB"}),
    681            $num_failures{"stdoutB"},  plural($num_failures{"stdoutB"}),
    682            $num_failures{"post"},     plural($num_failures{"post"}));
    683 
    684     foreach my $failure (@failures) {
    685         print "$failure\n";
    686     }
    687     print "\n";
    688 }
    689 
    690 #----------------------------------------------------------------------------
    691 # main(), sort of
    692 #----------------------------------------------------------------------------
    693 sub warn_about_EXTRA_REGTEST_OPTS()
    694 {
    695     print "WARNING: \$EXTRA_REGTEST_OPTS is set.  You probably don't want\n";
    696     print "to run the regression tests with it set, unless you are doing some\n";
    697     print "strange experiment, and/or you really know what you are doing.\n";
    698     print "\n";
    699 }
    700 
    701 # nuke VALGRIND_OPTS
    702 $ENV{"VALGRIND_OPTS"} = "";
    703 
    704 if ($ENV{"EXTRA_REGTEST_OPTS"}) {
    705     print "\n";
    706     warn_about_EXTRA_REGTEST_OPTS();
    707 }
    708 
    709 my @fs = process_command_line();
    710 while (1) { # we will exit after one loop, unless looptillfail
    711     foreach my $f (@fs) {
    712         if (-d $f) {
    713             test_one_dir($f, "");
    714         } else { 
    715             # Allow the .vgtest suffix to be given or omitted
    716             if ($f =~ /.vgtest$/ && -r $f) {
    717                 # do nothing
    718             } elsif (-r "$f.vgtest") {
    719                 $f = "$f.vgtest";
    720             } else {
    721                 die "`$f' neither a directory nor a readable test file/name\n"
    722             }
    723             my $dir  = `dirname  $f`;   chomp $dir;
    724             my $file = `basename $f`;   chomp $file;
    725             chdir($dir) or die "Could not change into $dir\n";
    726             do_one_test($dir, $file);
    727         }
    728         chdir($tests_dir);
    729     }
    730     if ($looptillfail == 0) {
    731         last;
    732     }
    733 }
    734 summarise_results();
    735 
    736 if ($ENV{"EXTRA_REGTEST_OPTS"}) {
    737     warn_about_EXTRA_REGTEST_OPTS();
    738 }
    739 
    740 if (0 == $num_failures{"stdout"} &&
    741     0 == $num_failures{"stderr"} &&
    742     0 == $num_failures{"stdoutB"} &&
    743     0 == $num_failures{"stderrB"} &&
    744     0 == $num_failures{"post"}) {
    745     exit 0;
    746 } else {
    747     exit 1;
    748 }
    749 
    750 ##--------------------------------------------------------------------##
    751 ##--- end                                               vg_regtest ---##
    752 ##--------------------------------------------------------------------##
    753