tests/vg_regtest.in

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