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