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