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 #----------------------------------------------------------------------------
 137 # Global vars
 138 #----------------------------------------------------------------------------
 139 my $usage="\n"
 140      . "Usage:\n"
 141      . "   vg_regtest [--all, --valgrind, --valgrind-lib, --keep-unfiltered\n"
 142      . "                 --outer-valgrind, --outer-tool, --outer-args\n"
 143      . "                 --loop-till-fail]\n"
 144      . "   Use EXTRA_REGTEST_OPTS to supply extra args for all tests\n"
 145      . "\n";
 146
 147 my $tmp="vg_regtest.tmp.$$";
 148
 149 # Test variables
 150 my $vgopts;             # valgrind options
 151 my $prog;               # test prog
 152 my $args;               # test prog args
 153 my $stdout_filter;      # filter program to run stdout results file through
 154 my $stderr_filter;      # filter program to run stderr results file through
 155 my $stdout_filter_args; # arguments passed to stdout_filter
 156 my $stderr_filter_args; # arguments passed to stderr_filter
 157 my $progB;              # Same but for progB
 158 my $argsB;              #
 159 my $stdoutB_filter;     #
 160 my $stderrB_filter;     #
 161 my $stdoutB_filter_args;# arguments passed to stdout_filterB
 162 my $stderrB_filter_args;# arguments passed to stderr_filterB
 163 my $stdinB;             # Input file for progB
 164 my $prereq;             # prerequisite test to satisfy before running test
 165 my $post;               # check command after running test
 166 my $cleanup;            # cleanup command to run
 167 my @env = ();           # environment variable to set prior calling $prog
 168 my @envB = ();          # environment variable to set prior calling $progB
 169
 170 my @failures;           # List of failed tests
 171
 172 my $num_tests_done      = 0;
 173 my %num_failures        = (stderr => 0, stdout => 0,
 174                            stderrB => 0, stdoutB => 0,
 175                            post => 0);
 176 my %num_results         = ();
 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 # open overall testsuite log that will contain records of all
 197 # subdirectory tests; it's not in automake format, but then again
 198 # nor are the per-subdirectory ones used as presence-flags for bunseno
 199 open(TSLOG, '>', 'test-suite-overall.log') or die $!;
 200
 201
 202 #----------------------------------------------------------------------------
 203 # Process command line, setup
 204 #----------------------------------------------------------------------------
 205
 206 # If $prog is a relative path, it prepends $dir to it.  Useful for two reasons:
 207 #
 208 # 1. Can prepend "." onto programs to avoid trouble with users who don't have
 209 #    "." in their path (by making $dir = ".")
 210 # 2. Can prepend the current dir to make the command absolute to avoid
 211 #    subsequent trouble when we change directories.
 212 #
 213 # Also checks the program exists and is executable.
 214 sub validate_program ($$$$)
 215 {
 216     my ($dir, $prog, $must_exist, $must_be_executable) = @_;
 217
 218     # If absolute path, leave it alone.  If relative, make it
 219     # absolute -- by prepending current dir -- so we can change
 220     # dirs and still use it.
 221     $prog = "$dir/$prog" if ($prog !~ /^\//);
 222     if ($must_exist) {
 223         (-f $prog) or die "vg_regtest: `$prog' not found or not a file ($dir)\n";
 224     }
 225     if ($must_be_executable) {
 226         (-x $prog) or die "vg_regtest: `$prog' not executable ($dir)\n";
 227     }
 228
 229     return $prog;
 230 }
 231
 232 sub process_command_line()
 233 {
 234     my $alldirs = 0;
 235     my @fs;
 236
 237     for my $arg (@ARGV) {
 238         if ($arg =~ /^-/) {
 239             if      ($arg =~ /^--all$/) {
 240                 $alldirs = 1;
 241             } elsif ($arg =~ /^--valgrind=(.*)$/) {
 242                 $valgrind = $1;
 243             } elsif ($arg =~ /^--outer-valgrind=(.*)$/) {
 244                 $outer_valgrind = $1;
 245             } elsif ($arg =~ /^--outer-tool=(.*)$/) {
 246                 $outer_tool = $1;
 247             } elsif ($arg =~ /^--outer-args=(.*)$/) {
 248                 $outer_args = $1;
 249             } elsif ($arg =~ /^--valgrind-lib=(.*)$/) {
 250                 $valgrind_lib = $1;
 251             } elsif ($arg =~ /^--keep-unfiltered$/) {
 252                 $keepunfiltered = 1;
 253             } elsif ($arg =~ /^--loop-till-fail$/) {
 254                 $looptillfail = 1;
 255             } else {
 256                 die $usage;
 257             }
 258         } else {
 259             push(@fs, $arg);
 260         }
 261     }
 262     $valgrind = validate_program($tests_dir, $valgrind, 1, 0);
 263
 264     if (defined $outer_valgrind) {
 265       $outer_valgrind = validate_program($tests_dir, $outer_valgrind, 1, 1);
 266       if ((not defined $outer_args)  || ($outer_args =~ /^\+/)) {
 267           $run_outer_args =
 268                 " --command-line-only=yes"
 269               . " --sim-hints=enable-outer"
 270               . " --run-libc-freeres=no --run-cxx-freeres=no"
 271               . " --smc-check=all-non-file"
 272               . " --vgdb=no --trace-children=yes --read-var-info=no"
 273               . " --read-inline-info=yes"
 274               . " --suppressions="
 275               . validate_program($tests_dir,"./tests/outer_inner.supp",1,0)
 276               . " --memcheck:leak-check=full --memcheck:show-reachable=no"
 277               . " --num-callers=40"
 278               . " ";
 279               # we use a (relatively) big --num-callers, to allow the outer to report
 280               # also the inner guest stack trace, when reporting an error.
 281           if (defined $outer_args) {
 282              $outer_args =~ s/^\+(.*)/$1/;
 283              $run_outer_args = $run_outer_args . $outer_args;
 284           }
 285       } else {
 286           $run_outer_args = $outer_args;
 287       }
 288     }
 289
 290     if ($alldirs) {
 291         @fs = ();
 292         foreach my $f (glob "*") {
 293             push(@fs, $f) if (-d $f);
 294         }
 295     }
 296
 297     (0 != @fs) or die "No test files or directories specified\n";
 298
 299     return @fs;
 300 }
 301
 302 #----------------------------------------------------------------------------
 303 # Read a .vgtest file
 304 #----------------------------------------------------------------------------
 305 sub read_vgtest_file($)
 306 {
 307     my ($f) = @_;
 308
 309     # Defaults.
 310     ($vgopts, $prog, $args, @env)      = ("", undef, "", ());
 311     ($stdout_filter, $stderr_filter)   = (undef, undef);
 312     ($progB, $argsB, $stdinB, @envB)   = (undef, "", undef, ());
 313     ($stdoutB_filter, $stderrB_filter) = (undef, undef);
 314     ($prereq, $post, $cleanup)         = (undef, undef, undef);
 315     ($stdout_filter_args, $stderr_filter_args)   = (undef, undef);
 316     ($stdoutB_filter_args, $stderrB_filter_args) = (undef, undef);
 317
 318     # Every test directory must have a "filter_stderr"
 319     $stderr_filter = validate_program(".", $default_stderr_filter, 1, 1);
 320     $stderrB_filter = validate_program(".", $default_stderr_filter, 1, 1);
 321
 322
 323     open(INPUTFILE, "< $f") || die "File $f not openable\n";
 324
 325     while (my $line = <INPUTFILE>) {
 326         if      ($line =~ /^\s*#/ || $line =~ /^\s*$/) {
 327             next;
 328         } elsif ($line =~ /^\s*vgopts:\s*(.*)$/) {
 329             my $addvgopts = $1;
 330             $addvgopts =~ s/\$\{PWD\}/$ENV{PWD}/g;
 331             $vgopts = $vgopts . " " . $addvgopts;   # Nb: Make sure there's a space!
 332         } elsif ($line =~ /^\s*prog:\s*(.*)$/) {
 333             $prog = validate_program(".", $1, 0, 0);
 334         } elsif ($line =~ /^\s*prog-asis:\s*(.*)$/) {
 335             $prog = $1;
 336         } elsif ($line =~ /^\s*args:\s*(.*)$/) {
 337             $args = $1;
 338         } elsif ($line =~ /^\s*stdout_filter:\s*(.*)$/) {
 339             $stdout_filter = validate_program(".", $1, 1, 1);
 340         } elsif ($line =~ /^\s*stderr_filter:\s*(.*)$/) {
 341             $stderr_filter = validate_program(".", $1, 1, 1);
 342         } elsif ($line =~ /^\s*stdout_filter_args:\s*(.*)$/) {
 343             $stdout_filter_args = $1;
 344         } elsif ($line =~ /^\s*stderr_filter_args:\s*(.*)$/) {
 345             $stderr_filter_args = $1;
 346         } elsif ($line =~ /^\s*progB:\s*(.*)$/) {
 347             $progB = validate_program(".", $1, 0, 0);
 348         } elsif ($line =~ /^\s*argsB:\s*(.*)$/) {
 349             $argsB = $1;
 350         } elsif ($line =~ /^\s*stdinB:\s*(.*)$/) {
 351             $stdinB = $1;
 352         } elsif ($line =~ /^\s*stdoutB_filter:\s*(.*)$/) {
 353             $stdoutB_filter = validate_program(".", $1, 1, 1);
 354         } elsif ($line =~ /^\s*stderrB_filter:\s*(.*)$/) {
 355             $stderrB_filter = validate_program(".", $1, 1, 1);
 356         } elsif ($line =~ /^\s*stdoutB_filter_args:\s*(.*)$/) {
 357             $stdoutB_filter_args = $1;
 358         } elsif ($line =~ /^\s*stderrB_filter_args:\s*(.*)$/) {
 359             $stderrB_filter_args = $1;
 360         } elsif ($line =~ /^\s*prereq:\s*(.*)$/) {
 361             $prereq = $1;
 362         } elsif ($line =~ /^\s*post:\s*(.*)$/) {
 363             $post = $1;
 364         } elsif ($line =~ /^\s*cleanup:\s*(.*)$/) {
 365             $cleanup = $1;
 366         } elsif ($line =~ /^\s*env:\s*(.*)$/) {
 367             push @env,$1;
 368         } elsif ($line =~ /^\s*envB:\s*(.*)$/) {
 369             push @envB,$1;
 370         } else {
 371             die "Bad line in $f: $line\n";
 372         }
 373     }
 374     close(INPUTFILE);
 375
 376     if (!defined $prog) {
 377         $prog = "";     # allow no prog for testing error and --help cases
 378     }
 379 }
 380
 381 #----------------------------------------------------------------------------
 382 # Do one test
 383 #----------------------------------------------------------------------------
 384 # Since most of the program time is spent in system() calls, need this to
 385 # propagate a Ctrl-C enabling us to quit.
 386 sub mysystem($@)
 387 {
 388     my $tslog = shift(@_);
 389     print $tslog scalar localtime, " executing @_\n";
 390     my $exit_code = system(@_);
 391     print $tslog scalar localtime, " rc $exit_code\n";
 392     ($exit_code == 2) and exit 1;      # 2 is SIGINT
 393     return $exit_code;
 394 }
 395
 396 # if $keepunfiltered, copies $1 to $1.unfiltered.out
 397 # renames $0 tp $1
 398 sub filtered_rename($$$)
 399 {
 400     if ($keepunfiltered == 1) {
 401         mysystem($_[2], "cp  $_[1] $_[1].unfiltered.out");
 402     }
 403     rename ($_[0], $_[1]);
 404 }
 405
 406
 407 # from a directory name like "/foo/cachesim/tests/" determine the tool name
 408 sub determine_tool()
 409 {
 410     my $dir = `pwd`;
 411     $dir =~ /.*\/([^\/]+)\/tests.*/;   # foo/tool_name/tests/foo
 412     return $1;
 413 }
 414
 415 # Compare output against expected output;  it should match at least one of
 416 # them.
 417 sub do_diffs($$$$$)
 418 {
 419     my ($fullname, $name, $mid, $tslog, $f_exps) = @_;
 420     if (! defined $tslog) {$tslog = *TSLOG;}
 421
 422     for my $f_exp (@$f_exps) {
 423         (-r $f_exp) or die "Could not read `$f_exp'\n";
 424
 425         # Emacs produces temporary files that end in '~' and '#'.  We ignore
 426         # these.
 427         if ($f_exp !~ /[~#]$/) {
 428             # $n is the (optional) suffix after the ".exp";  we tack it onto
 429             # the ".diff" file.
 430             my $n = "";
 431             if ($f_exp =~ /.*\.exp(.*)$/) {
 432                 $n = $1;
 433             } else {
 434                 $n = "";
 435                 ($f_exp eq "/dev/null") or die "Unexpected .exp file: $f_exp\n";
 436             }
 437
 438             mysystem($tslog, "@DIFF@ $f_exp $name.$mid.out > $name.$mid.diff$n");
 439             open (F,"<","$name.$mid.diff$n");
 440             while (<F>) { print $tslog $_; }
 441             close (F);
 442
 443             if (not -s "$name.$mid.diff$n") {
 444                 # A match;  remove .out and any previously created .diff files.
 445                 unlink("$name.$mid.out");
 446                 unlink(<$name.$mid.diff*>);
 447                 return;
 448             }
 449         }
 450     }
 451     # If we reach here, none of the .exp files matched.
 452     print "*** $name failed ($mid) ***\n";
 453     push(@failures, sprintf("%-40s ($mid)", "$fullname"));
 454     $num_failures{$mid}++;
 455     if ($looptillfail == 1) {
 456        print "Failure encountered, stopping to loop\n";
 457        exit 1
 458     }
 459     return "FAIL";
 460 }
 461
 462 sub do_one_test($$)
 463 {
 464     my ($dir, $vgtest) = @_;
 465     $vgtest =~ /^(.*)\.vgtest/;
 466     my $name = $1;
 467     my $fullname = "$dir/$name";
 468
 469     # Pull any extra options (for example, --sanity-level=4)
 470     # from $EXTRA_REGTEST_OPTS.
 471     my $maybe_extraopts = $ENV{"EXTRA_REGTEST_OPTS"};
 472     my $extraopts = $maybe_extraopts ?  $maybe_extraopts  : "";
 473
 474     read_vgtest_file($vgtest);
 475     print TSLOG scalar localtime, " processing $dir/$vgtest\n";
 476
 477     my $rc = "PASS";
 478     # $vgtest.trs is opened by caller, so as to absorb $rc reliably, even from early returns
 479     open(VGTESTLOG,">","$vgtest.log") or die $!;
 480
 481     if (defined $prereq) {
 482         my $prereq_res = mysystem(*VGTESTLOG, "/bin/sh", "-c", $prereq);
 483         if (0 == $prereq_res) {
 484             # Do nothing (ie. continue with the test)
 485         } elsif (256 == $prereq_res) {
 486             # Nb: weird Perl-ism -- exit code of '1' is seen by Perl as 256...
 487             # Prereq failed, skip.
 488             printf("%-16s (skipping, prereq failed: $prereq)\n", "$name:");
 489             print VGTESTLOG scalar localtime, " skipping, prereq failed\n";
 490             close(VGTESTLOG);
 491             return "SKIP";
 492         } else {
 493             # Bad prereq; abort.
 494             $prereq_res /= 256;
 495             die "prereq returned $prereq_res: $prereq\n";
 496         }
 497     }
 498
 499
 500     if (defined $progB) {
 501         # Collect environment variables, if any.
 502         my $envBvars = "";
 503         foreach my $e (@envB) {
 504            $envBvars = "$envBvars $e";
 505         }
 506         # If there is a progB, let's start it in background:
 507         printf("%-16s valgrind $extraopts $vgopts $prog $args (progB: $progB $argsB)\n",
 508                "$name:");
 509         # progB.done used to detect child has finished. See below.
 510         # Note: redirection of stdout and stderr is before $progB to allow argsB
 511         # to e.g. redirect stdoutB to stderrB
 512         if (defined $stdinB) {
 513             mysystem(*VGTESTLOG, "(rm -f progB.done;"
 514                      . " < $stdinB > $name.stdoutB.out 2> $name.stderrB.out"
 515                      . " $envBvars $progB $argsB;"
 516                      . "touch progB.done) &");
 517         } else {
 518             mysystem(*VGTESTLOG, "(rm -f progB.done;"
 519                      . " > $name.stdoutB.out 2> $name.stderrB.out"
 520                      . "$envBvars $progB $argsB;"
 521                      . "touch progB.done)  &");
 522         }
 523     } else {
 524         printf("%-16s valgrind $extraopts $vgopts $prog $args\n", "$name:");
 525     }
 526
 527     # Collect environment variables, if any.
 528     my $envvars = "";
 529     foreach my $e (@env) {
 530         $envvars = "$envvars $e";
 531     }
 532
 533     # Pass the appropriate --tool option for the directory (can be overridden
 534     # by an "args:" line, though).
 535     my $tool=determine_tool();
 536     if (defined $outer_valgrind ) {
 537         # in an outer-inner setup, only set VALGRIND_LIB_INNER
 538         mysystem(*VGTESTLOG,
 539                     "$envvars VALGRIND_LIB_INNER=$valgrind_lib "
 540                   . "$outer_valgrind "
 541                   . "--tool=" . $outer_tool . " "
 542                   . "--log-file=" . "$name.outer.log "
 543                   . "$run_outer_args "
 544                   . "$valgrind --command-line-only=yes --memcheck:leak-check=no "
 545                   . "--sim-hints=no-inner-prefix "
 546                   . "--tool=$tool $extraopts $vgopts "
 547                   . "$prog $args > $name.stdout.out 2> $name.stderr.out");
 548     } else {
 549         # Set both VALGRIND_LIB and VALGRIND_LIB_INNER in case this Valgrind
 550         # was configured with --enable-inner.
 551         mysystem(*VGTESTLOG,
 552                     "$envvars VALGRIND_LIB=$valgrind_lib VALGRIND_LIB_INNER=$valgrind_lib "
 553                   . "$valgrind --command-line-only=yes --memcheck:leak-check=no "
 554                   . "--tool=$tool $extraopts $vgopts "
 555                   . "$prog $args > $name.stdout.out 2> $name.stderr.out");
 556     }
 557
 558     # Transcribe stdout, stderr
 559     print VGTESTLOG scalar localtime, " stdout:\n";
 560     open (F,"<","$name.stdout.out");
 561     while (<F>) { print VGTESTLOG $_; }
 562     close (F);
 563     print VGTESTLOG scalar localtime, " stderr:\n";
 564     open (F,"<","$name.stderr.out");
 565     while (<F>) { print VGTESTLOG $_; }
 566     close (F);
 567
 568     # Filter stdout
 569     if (defined $stdout_filter) {
 570         $stdout_filter_args = $name if (! defined $stdout_filter_args);
 571         mysystem(*VGTESTLOG,
 572                  "$stdout_filter $stdout_filter_args < $name.stdout.out > $tmp");
 573         filtered_rename($tmp, "$name.stdout.out", *VGTESTLOG);
 574     }
 575     # Find all the .stdout.exp files.  If none, use /dev/null.
 576     my @stdout_exps = <$name.stdout.exp*>;
 577     @stdout_exps = ( "/dev/null" ) if (0 == scalar @stdout_exps);
 578     my $diffrc = do_diffs($fullname, $name, "stdout", *VGTESTLOG, \@stdout_exps);
 579     if (defined $diffrc) { $rc = $diffrc; }
 580
 581     # Filter stderr
 582     $stderr_filter_args = $name if (! defined $stderr_filter_args);
 583     mysystem(*VGTESTLOG,
 584              "$stderr_filter $stderr_filter_args < $name.stderr.out > $tmp");
 585     filtered_rename($tmp, "$name.stderr.out", *VGTESTLOG);
 586     # Find all the .stderr.exp files.  At least one must exist.
 587     my @stderr_exps = <$name.stderr.exp*>;
 588     (0 != scalar @stderr_exps) or die "Could not find `$name.stderr.exp*'\n";
 589     $diffrc = do_diffs($fullname, $name, "stderr", *VGTESTLOG, \@stderr_exps);
 590     if (defined $diffrc) { $rc = $diffrc; }
 591
 592     if (defined $progB) {
 593         # wait for the child to be finished
 594         # tried things such as:
 595         #   wait;
 596         #   $SIG{CHLD} = sub { wait };
 597         # but nothing worked:
 598         # e.g. running mssnapshot.vgtest in a loop failed from time to time
 599         # due to some missing output (not yet written?).
 600         # So, we search progB.done during max 100 times 100 millisecond.
 601         my $count;
 602         for ($count = 1; $count <= 100; $count++) {
 603             (-f "progB.done") or select(undef, undef, undef, 0.100);
 604         }
 605
 606         # Transcribe stdout, stderr
 607         print VGTESTLOG scalar localtime, " stdoutB:\n";
 608         open (F,"<","$name.stdoutB.out");
 609         while (<F>) { print VGTESTLOG $_; }
 610         close (F);
 611         print VGTESTLOG scalar localtime, " stderrB:\n";
 612         open (F,"<","$name.stderrB.out");
 613         while (<F>) { print VGTESTLOG $_; }
 614         close (F);
 615
 616         # Filter stdout
 617         if (defined $stdoutB_filter) {
 618             $stdoutB_filter_args = $name if (! defined $stdoutB_filter_args);
 619             mysystem(*VGTESTLOG,
 620                      "$stdoutB_filter $stdoutB_filter_args < $name.stdoutB.out > $tmp");
 621             filtered_rename($tmp, "$name.stdoutB.out", *VGTESTLOG);
 622         }
 623         # Find all the .stdoutB.exp files.  If none, use /dev/null.
 624         my @stdoutB_exps = <$name.stdoutB.exp*>;
 625         @stdoutB_exps = ( "/dev/null" ) if (0 == scalar @stdoutB_exps);
 626         $diffrc = do_diffs($fullname, $name, "stdoutB", *VGTESTLOG, \@stdoutB_exps);
 627         if (defined $diffrc) { $rc = $diffrc; }
 628
 629         # Filter stderr
 630         $stderrB_filter_args = $name if (! defined $stderrB_filter_args);
 631         mysystem(*VGTESTLOG,
 632                  "$stderrB_filter $stderrB_filter_args < $name.stderrB.out > $tmp");
 633         filtered_rename($tmp, "$name.stderrB.out", *VGTESTLOG);
 634         # Find all the .stderrB.exp files.  At least one must exist.
 635         my @stderrB_exps = <$name.stderrB.exp*>;
 636         (0 != scalar @stderrB_exps) or die "Could not find `$name.stderrB.exp*'\n";
 637         $diffrc = do_diffs($fullname, $name, "stderrB", *VGTESTLOG, \@stderrB_exps);
 638         if (defined $diffrc) { $rc = $diffrc; }
 639     }
 640
 641     # Maybe do post-test check
 642     if (defined $post) {
 643         my $postrc = mysystem(*VGTESTLOG, "$post > $name.post.out");
 644         # Transcribe stdout
 645         print VGTESTLOG scalar localtime, " post:\n";
 646         open (F,"<","$name.post.out");
 647         while (<F>) { print VGTESTLOG $_; }
 648         close (F);
 649         if ($postrc != 0) {
 650             print("post check failed: $post\n");
 651             $rc = "FAIL";
 652             $num_failures{"post"}++;
 653         } else {
 654             # Find all the .post.exp files.  If none, use /dev/null.
 655             my @post_exps = <$name.post.exp*>;
 656             @post_exps = ( "/dev/null" ) if (0 == scalar @post_exps);
 657             do_diffs($fullname, $name, "post", *VGTESTLOG, \@post_exps);
 658         }
 659     }
 660
 661     if (defined $cleanup) {
 662         (mysystem(*VGTESTLOG, "$cleanup") == 0) or
 663             print("(cleanup operation failed: $cleanup)\n");
 664     }
 665
 666     close(VGTESTLOG);
 667     $num_tests_done++;
 668     return $rc;
 669 }
 670
 671 #----------------------------------------------------------------------------
 672 # Test one directory (and any subdirs)
 673 #----------------------------------------------------------------------------
 674 sub test_one_dir($$);    # forward declaration
 675
 676 sub test_one_dir($$)
 677 {
 678     my ($dir, $prev_dirs) = @_;
 679     $dir =~ s/\/$//;    # trim a trailing '/'
 680
 681     # Ignore dirs into which we should not recurse.
 682     if ($dir =~ /^(BitKeeper|CVS|SCCS|docs|doc)$/) { return; }
 683
 684     (-x "$tests_dir/tests/arch_test") or die
 685         "vg_regtest: 'arch_test' is missing.  Did you forget to 'make check'?\n";
 686
 687     # Ignore any dir whose name matches that of an architecture which is not
 688     # the architecture we are running on.  Eg. when running on x86, ignore
 689     # ppc/ directories ('arch_test' returns 1 for this case).  Likewise for
 690     # the OS and platform.
 691     # Nb: weird Perl-ism -- exit code of '1' is seen by Perl as 256...
 692     if (256 == system("$tests_dir/tests/arch_test $dir"))  { return; }
 693     if (256 == system("$tests_dir/tests/os_test   $dir"))  { return; }
 694     if ($dir =~ /(\w+)-(\w+)/ &&
 695         256 == system("sh $tests_dir/tests/platform_test $1 $2")) { return; }
 696     if ($dir =~ "dSYM") { return; }
 697
 698     chdir($dir) or die "Could not change into $dir\n";
 699
 700     # Nb: Don't prepend a '/' to the base directory
 701     my $full_dir = $prev_dirs . ($prev_dirs eq "" ? "" : "/") . $dir;
 702     print TSLOG scalar localtime, " entering $full_dir\n";
 703     my $dashes = "-" x (50 - length $full_dir);
 704
 705     my @fs = glob "*";
 706     my $found_tests = (0 != (grep { $_ =~ /\.vgtest$/ } @fs));
 707
 708     my $tests_start_time = time;
 709     if ($found_tests) {
 710         print "-- Running  tests in $full_dir $dashes\n";
 711     }
 712     foreach my $f (@fs) {
 713         if (-d $f) {
 714             test_one_dir($f, $full_dir);
 715         } elsif ($f =~ /\.vgtest$/) {
 716             open(TSDIRLOG,">","test-suite.log") or die $!; # it's enough for the per-directory file to exist for bunsen
 717             print TSDIRLOG "See *.log files for details on each test in this directory.\n";
 718             print TSDIRLOG "See $tests_dir/test-suite-overall.log\n";
 719             print TSDIRLOG "    for overall results, including all non-PASS .log contents.\n";
 720             close(TSDIRLOG);
 721             my $result = do_one_test($full_dir, $f);
 722             print TSLOG scalar localtime, " result: $result $full_dir/$f.log\n";
 723             $num_results{$result} ++;
 724             if ($result ne "PASS") {
 725                # transcribe .log file into the overall log.
 726                open(LOGFILE, "< $f.log") || die "Cannot open $f.log";
 727                while (<LOGFILE>) { print TSLOG "|\t$_"; }
 728                close(LOGFILE);
 729             }
 730             open(VGTESTTRS,">","$f.trs") or die "$!";
 731             print VGTESTTRS ":test-result: $result\n";
 732             print VGTESTTRS ":global-test-result: $result\n";
 733             print VGTESTTRS ":recheck: no\n"; # ?
 734             print VGTESTTRS ":copy-in-global-log: no\n"; # ?
 735             close(VGTESTTRS);
 736         }
 737     }
 738     if ($found_tests) {
 739         my $tests_cost_time = time - $tests_start_time;
 740         my $end_time = "(in $tests_cost_time sec)";
 741         my $end_dashes = "-" x (50 - (length $full_dir)
 742                                    - (length $end_time) - 1);
 743         print "-- Finished tests in $full_dir $end_time $end_dashes\n";
 744     }
 745
 746     print TSLOG scalar localtime, " leaving $full_dir\n";
 747     chdir("..");
 748 }
 749
 750 #----------------------------------------------------------------------------
 751 # Summarise results
 752 #----------------------------------------------------------------------------
 753 sub plural($)
 754 {
 755    return ( $_[0] == 1 ? "" : "s" );
 756 }
 757
 758 sub summarise_results
 759 {
 760     my $x = ( $num_tests_done == 1 ? "test" : "tests" );
 761
 762     printf("\n== %d test%s, %d stderr failure%s, %d stdout failure%s, "
 763                          . "%d stderrB failure%s, %d stdoutB failure%s, "
 764                          . "%d post failure%s ==\n",
 765            $num_tests_done, plural($num_tests_done),
 766            $num_failures{"stderr"},   plural($num_failures{"stderr"}),
 767            $num_failures{"stdout"},   plural($num_failures{"stdout"}),
 768            $num_failures{"stderrB"},  plural($num_failures{"stderrB"}),
 769            $num_failures{"stdoutB"},  plural($num_failures{"stdoutB"}),
 770            $num_failures{"post"},     plural($num_failures{"post"}));
 771
 772     foreach my $failure (@failures) {
 773         print "$failure\n";
 774     }
 775     print "\n";
 776
 777     # automake style summarize in TSLOG also
 778     print TSLOG "\n\nResults\n";
 779     while (my ($k,$v) = each %num_results) {
 780         printf TSLOG "# %5s: %d\n", $k, $v;
 781     }
 782     printf TSLOG "# %5s: %d\n", "total", $num_tests_done;
 783 }
 784
 785 #----------------------------------------------------------------------------
 786 # main(), sort of
 787 #----------------------------------------------------------------------------
 788 sub warn_about_EXTRA_REGTEST_OPTS()
 789 {
 790     print "WARNING: \$EXTRA_REGTEST_OPTS is set.  You probably don't want\n";
 791     print "to run the regression tests with it set, unless you are doing some\n";
 792     print "strange experiment, and/or you really know what you are doing.\n";
 793     print "\n";
 794 }
 795
 796 # nuke VALGRIND_OPTS
 797 $ENV{"VALGRIND_OPTS"} = "";
 798 # nuke DEBUGINFOD_URLS
 799 $ENV{"DEBUGINFOD_URLS"} = "";
 800
 801 if ($ENV{"EXTRA_REGTEST_OPTS"}) {
 802     print "\n";
 803     warn_about_EXTRA_REGTEST_OPTS();
 804 }
 805
 806 my @fs = process_command_line();
 807 while (1) { # we will exit after one loop, unless looptillfail
 808     foreach my $f (@fs) {
 809         if (-d $f) {
 810             test_one_dir($f, "");
 811         } else {
 812             # Allow the .vgtest suffix to be given or omitted
 813             if ($f =~ /.vgtest$/ && -r $f) {
 814                 # do nothing
 815             } elsif (-r "$f.vgtest") {
 816                 $f = "$f.vgtest";
 817             } else {
 818                 die "`$f' neither a directory nor a readable test file/name\n"
 819             }
 820             my $dir  = `dirname  $f`;   chomp $dir;
 821             my $file = `basename $f`;   chomp $file;
 822             chdir($dir) or die "Could not change into $dir\n";
 823
 824             my $result = do_one_test($dir, $file);
 825             print TSLOG scalar localtime, " result: $result $dir/$file.log\n";
 826             $num_results{$result} ++;
 827             if ($result ne "PASS") {
 828                # transcribe .log file into the overall log.
 829                open(LOGFILE, "< $file.log") || die "Cannot open $file.log";
 830                while (<LOGFILE>) { print TSLOG "|\t$_"; }
 831                close(LOGFILE);
 832             }
 833             open(VGTESTTRS,">","$file.trs") or die $!;
 834             print VGTESTTRS ":test-result: $result\n";
 835             print VGTESTTRS ":global-test-result: $result\n";
 836             print VGTESTTRS ":recheck: no\n"; # ?
 837             print VGTESTTRS ":copy-in-global-log: no\n"; # ?
 838             close(VGTESTTRS);
 839         }
 840         chdir($tests_dir);
 841     }
 842     if ($looptillfail == 0) {
 843         last;
 844     }
 845 }
 846 summarise_results();
 847
 848 if ($ENV{"EXTRA_REGTEST_OPTS"}) {
 849     warn_about_EXTRA_REGTEST_OPTS();
 850 }
 851
 852 if (0 == $num_failures{"stdout"} &&
 853     0 == $num_failures{"stderr"} &&
 854     0 == $num_failures{"stdoutB"} &&
 855     0 == $num_failures{"stderrB"} &&
 856     0 == $num_failures{"post"}) {
 857     exit 0;
 858 } else {
 859     exit 1;
 860 }
 861
 862 ##--------------------------------------------------------------------##
 863 ##--- end                                               vg_regtest ---##
 864 ##--------------------------------------------------------------------##