#! /usr/bin/perl ##--------------------------------------------------------------------## ##--- Valgrind regression testing script vg_regtest ---## ##--------------------------------------------------------------------## # This file is part of Valgrind, a dynamic binary instrumentation # framework. # # Copyright (C) 2003-2017 Nicholas Nethercote # njn@valgrind.org # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as # published by the Free Software Foundation; either version 2 of the # License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA # 02111-1307, USA. # # The GNU General Public License is contained in the file COPYING. #---------------------------------------------------------------------------- # usage: vg_regtest [options] # # Options: # --all: run tests in all subdirs # --valgrind: valgrind launcher to use. Default is ./coregrind/valgrind. # (This option should probably only be used in conjunction with # --valgrind-lib.) # --valgrind-lib: valgrind libraries to use. Default is $tests_dir/.in_place. # (This option should probably only be used in conjunction with # --valgrind.) # --keep-unfiltered: keep a copy of the unfiltered output/error output # of each test by adding an extension .unfiltered.out # # --outer-valgrind: run this valgrind under the given outer valgrind. # This valgrind must be configured with --enable-inner. # --outer-tool: tool to use by the outer valgrind (default memcheck). # --outer-args: use this as outer tool args. If the outer args are starting # with +, the given outer args are appended to the outer args predefined # by vg_regtest. # --loop-till-fail: loops on the test(s) till one fail, then exit # This is useful to obtain detailed trace or --keep-unfiltered # output of a non deterministic test failure # # The easiest way is to run all tests in valgrind/ with (assuming you installed # in $PREFIX): # # $PREFIX/bin/vg_regtest --all # # You can specify individual files to test, or whole directories, or both. # Directories are traversed recursively, except for ones named, for example, # CVS/ or docs/. # # Each test is defined in a file .vgtest, containing one or more of the # following lines, in any order: # - prog: # - prog-asis: # - env: (default: none) # - args: (default: none) # - vgopts: (default: none; # multiple are allowed) # - stdout_filter: (default: none) # - stderr_filter: (default: ./filter_stderr) # - stdout_filter_args: (default: basename of .vgtest file) # - stderr_filter_args: (default: basename of .vgtest file) # # - progB: (default: none) # - envB: (default: none) # - argsB: (default: none) # - stdinB: (default: none) # - stdoutB_filter: (default: none) # - stderrB_filter: (default: ./filter_stderr) # - stdoutB_filter_args: (default: basename of .vgtest file) # - stderrB_filter_args: (default: basename of .vgtest file) # # - prereq: (default: none) # - post: (default: none) # - cleanup: (default: none) # # One of prog or prog-asis must be specified. # If prog or probB is a relative path, it will be prefix with the test directory. # prog-asis will be taken as is, i.e. not prefixed with the test directory. # Note that filters are necessary for stderr results to filter out things that # always change, eg. process id numbers. # Note that if a progB is specified, it is started in background (before prog). # # There can be more than one env: declaration. Here is an example: # env: PATH=/opt/bin:$PATH # Likewise for envB. # # Expected stdout (filtered) is kept in .stdout.exp* (can be more # than one expected output). It can be missing if it would be empty. Expected # stderr (filtered) is kept in .stderr.exp*. There must be at least # one stderr.exp* file. Any .exp* file that ends in '~' or '#' is ignored; # this is because Emacs creates temporary files of these names. # # Expected output for progB is handled similarly, except that # expected stdout and stderr for progB are in .stdoutB.exp* # and .stderrB.exp*. # # If results don't match, the output can be found in .std.out, # and the diff between expected and actual in .std.diff*. # (for progB, in .std2.out and .std2.diff*). # # The prerequisite command, if present, works like this: # - if it returns 0 the test is run # - if it returns 1 the test is skipped # - if it returns anything else the script aborts. # The idea here is results other than 0 or 1 are likely to be due to # problems with the commands, and you don't want to conflate them with the 1 # case, which would happen if you just tested for zero or non-zero. # # The post-test command, if present, must return 0 and its stdout must match # the expected stdout which is kept in .post.exp*. # # Sometimes it is useful to run all the tests at a high sanity check # level or with arbitrary other flags. To make this simple, extra # options, applied to all tests run, are read from $EXTRA_REGTEST_OPTS, # and handed to valgrind prior to any other flags specified by the # .vgtest file. # # Some more notes on adding regression tests for a new tool are in # docs/xml/manual-writing-tools.xml. #---------------------------------------------------------------------------- use warnings; use strict; #---------------------------------------------------------------------------- # Global vars #---------------------------------------------------------------------------- my $usage="\n" . "Usage:\n" . " vg_regtest [--all, --valgrind, --valgrind-lib, --keep-unfiltered\n" . " --outer-valgrind, --outer-tool, --outer-args\n" . " --loop-till-fail]\n" . " Use EXTRA_REGTEST_OPTS to supply extra args for all tests\n" . "\n"; my $tmp="vg_regtest.tmp.$$"; # Test variables my $vgopts; # valgrind options my $prog; # test prog my $args; # test prog args my $stdout_filter; # filter program to run stdout results file through my $stderr_filter; # filter program to run stderr results file through my $stdout_filter_args; # arguments passed to stdout_filter my $stderr_filter_args; # arguments passed to stderr_filter my $progB; # Same but for progB my $argsB; # my $stdoutB_filter; # my $stderrB_filter; # my $stdoutB_filter_args;# arguments passed to stdout_filterB my $stderrB_filter_args;# arguments passed to stderr_filterB my $stdinB; # Input file for progB my $prereq; # prerequisite test to satisfy before running test my $post; # check command after running test my $cleanup; # cleanup command to run my @env = (); # environment variable to set prior calling $prog my @envB = (); # environment variable to set prior calling $progB my @failures; # List of failed tests my $num_tests_done = 0; my %num_failures = (stderr => 0, stdout => 0, stderrB => 0, stdoutB => 0, post => 0); # Default valgrind to use is this build tree's (uninstalled) one my $valgrind = "./coregrind/valgrind"; chomp(my $tests_dir = `pwd`); # Outer valgrind to use, and args to use for it. my $outer_valgrind; my $outer_tool = "memcheck"; my $outer_args; my $run_outer_args = ""; my $valgrind_lib = "$tests_dir/.in_place"; my $keepunfiltered = 0; my $looptillfail = 0; # default filter is the one named "filter_stderr" in the test's directory my $default_stderr_filter = "filter_stderr"; #---------------------------------------------------------------------------- # Process command line, setup #---------------------------------------------------------------------------- # If $prog is a relative path, it prepends $dir to it. Useful for two reasons: # # 1. Can prepend "." onto programs to avoid trouble with users who don't have # "." in their path (by making $dir = ".") # 2. Can prepend the current dir to make the command absolute to avoid # subsequent trouble when we change directories. # # Also checks the program exists and is executable. sub validate_program ($$$$) { my ($dir, $prog, $must_exist, $must_be_executable) = @_; # If absolute path, leave it alone. If relative, make it # absolute -- by prepending current dir -- so we can change # dirs and still use it. $prog = "$dir/$prog" if ($prog !~ /^\//); if ($must_exist) { (-f $prog) or die "vg_regtest: `$prog' not found or not a file ($dir)\n"; } if ($must_be_executable) { (-x $prog) or die "vg_regtest: `$prog' not executable ($dir)\n"; } return $prog; } sub process_command_line() { my $alldirs = 0; my @fs; for my $arg (@ARGV) { if ($arg =~ /^-/) { if ($arg =~ /^--all$/) { $alldirs = 1; } elsif ($arg =~ /^--valgrind=(.*)$/) { $valgrind = $1; } elsif ($arg =~ /^--outer-valgrind=(.*)$/) { $outer_valgrind = $1; } elsif ($arg =~ /^--outer-tool=(.*)$/) { $outer_tool = $1; } elsif ($arg =~ /^--outer-args=(.*)$/) { $outer_args = $1; } elsif ($arg =~ /^--valgrind-lib=(.*)$/) { $valgrind_lib = $1; } elsif ($arg =~ /^--keep-unfiltered$/) { $keepunfiltered = 1; } elsif ($arg =~ /^--loop-till-fail$/) { $looptillfail = 1; } else { die $usage; } } else { push(@fs, $arg); } } $valgrind = validate_program($tests_dir, $valgrind, 1, 0); if (defined $outer_valgrind) { $outer_valgrind = validate_program($tests_dir, $outer_valgrind, 1, 1); if ((not defined $outer_args) || ($outer_args =~ /^\+/)) { $run_outer_args = " --command-line-only=yes" . " --run-libc-freeres=no --sim-hints=enable-outer" . " --smc-check=all-non-file" . " --vgdb=no --trace-children=yes --read-var-info=no" . " --read-inline-info=yes" . " --suppressions=" . validate_program($tests_dir,"./tests/outer_inner.supp",1,0) . " --memcheck:leak-check=full --memcheck:show-reachable=no" . " --num-callers=40" . " "; # we use a (relatively) big --num-callers, to allow the outer to report # also the inner guest stack trace, when reporting an error. if (defined $outer_args) { $outer_args =~ s/^\+(.*)/$1/; $run_outer_args = $run_outer_args . $outer_args; } } else { $run_outer_args = $outer_args; } } if ($alldirs) { @fs = (); foreach my $f (glob "*") { push(@fs, $f) if (-d $f); } } (0 != @fs) or die "No test files or directories specified\n"; return @fs; } #---------------------------------------------------------------------------- # Read a .vgtest file #---------------------------------------------------------------------------- sub read_vgtest_file($) { my ($f) = @_; # Defaults. ($vgopts, $prog, $args) = ("", undef, ""); ($stdout_filter, $stderr_filter) = (undef, undef); ($progB, $argsB, $stdinB) = (undef, "", undef); ($stdoutB_filter, $stderrB_filter) = (undef, undef); ($prereq, $post, $cleanup) = (undef, undef, undef); ($stdout_filter_args, $stderr_filter_args) = (undef, undef); ($stdoutB_filter_args, $stderrB_filter_args) = (undef, undef); # Every test directory must have a "filter_stderr" $stderr_filter = validate_program(".", $default_stderr_filter, 1, 1); $stderrB_filter = validate_program(".", $default_stderr_filter, 1, 1); open(INPUTFILE, "< $f") || die "File $f not openable\n"; while (my $line = ) { if ($line =~ /^\s*#/ || $line =~ /^\s*$/) { next; } elsif ($line =~ /^\s*vgopts:\s*(.*)$/) { my $addvgopts = $1; $addvgopts =~ s/\$\{PWD\}/$ENV{PWD}/g; $vgopts = $vgopts . " " . $addvgopts; # Nb: Make sure there's a space! } elsif ($line =~ /^\s*prog:\s*(.*)$/) { $prog = validate_program(".", $1, 0, 0); } elsif ($line =~ /^\s*prog-asis:\s*(.*)$/) { $prog = $1; } elsif ($line =~ /^\s*args:\s*(.*)$/) { $args = $1; } elsif ($line =~ /^\s*stdout_filter:\s*(.*)$/) { $stdout_filter = validate_program(".", $1, 1, 1); } elsif ($line =~ /^\s*stderr_filter:\s*(.*)$/) { $stderr_filter = validate_program(".", $1, 1, 1); } elsif ($line =~ /^\s*stdout_filter_args:\s*(.*)$/) { $stdout_filter_args = $1; } elsif ($line =~ /^\s*stderr_filter_args:\s*(.*)$/) { $stderr_filter_args = $1; } elsif ($line =~ /^\s*progB:\s*(.*)$/) { $progB = validate_program(".", $1, 0, 0); } elsif ($line =~ /^\s*argsB:\s*(.*)$/) { $argsB = $1; } elsif ($line =~ /^\s*stdinB:\s*(.*)$/) { $stdinB = $1; } elsif ($line =~ /^\s*stdoutB_filter:\s*(.*)$/) { $stdoutB_filter = validate_program(".", $1, 1, 1); } elsif ($line =~ /^\s*stderrB_filter:\s*(.*)$/) { $stderrB_filter = validate_program(".", $1, 1, 1); } elsif ($line =~ /^\s*stdoutB_filter_args:\s*(.*)$/) { $stdoutB_filter_args = $1; } elsif ($line =~ /^\s*stderrB_filter_args:\s*(.*)$/) { $stderrB_filter_args = $1; } elsif ($line =~ /^\s*prereq:\s*(.*)$/) { $prereq = $1; } elsif ($line =~ /^\s*post:\s*(.*)$/) { $post = $1; } elsif ($line =~ /^\s*cleanup:\s*(.*)$/) { $cleanup = $1; } elsif ($line =~ /^\s*env:\s*(.*)$/) { push @env,$1; } elsif ($line =~ /^\s*envB:\s*(.*)$/) { push @envB,$1; } else { die "Bad line in $f: $line\n"; } } close(INPUTFILE); if (!defined $prog) { $prog = ""; # allow no prog for testing error and --help cases } } #---------------------------------------------------------------------------- # Do one test #---------------------------------------------------------------------------- # Since most of the program time is spent in system() calls, need this to # propagate a Ctrl-C enabling us to quit. sub mysystem($) { my $exit_code = system($_[0]); ($exit_code == 2) and exit 1; # 2 is SIGINT return $exit_code; } # if $keepunfiltered, copies $1 to $1.unfiltered.out # renames $0 tp $1 sub filtered_rename($$) { if ($keepunfiltered == 1) { mysystem("cp $_[1] $_[1].unfiltered.out"); } rename ($_[0], $_[1]); } # from a directory name like "/foo/cachesim/tests/" determine the tool name sub determine_tool() { my $dir = `pwd`; $dir =~ /.*\/([^\/]+)\/tests.*/; # foo/tool_name/tests/foo return $1; } # Compare output against expected output; it should match at least one of # them. sub do_diffs($$$$) { my ($fullname, $name, $mid, $f_exps) = @_; for my $f_exp (@$f_exps) { (-r $f_exp) or die "Could not read `$f_exp'\n"; # Emacs produces temporary files that end in '~' and '#'. We ignore # these. if ($f_exp !~ /[~#]$/) { # $n is the (optional) suffix after the ".exp"; we tack it onto # the ".diff" file. my $n = ""; if ($f_exp =~ /.*\.exp(.*)$/) { $n = $1; } else { $n = ""; ($f_exp eq "/dev/null") or die "Unexpected .exp file: $f_exp\n"; } mysystem("diff -u $f_exp $name.$mid.out > $name.$mid.diff$n"); if (not -s "$name.$mid.diff$n") { # A match; remove .out and any previously created .diff files. unlink("$name.$mid.out"); unlink(<$name.$mid.diff*>); return; } } } # If we reach here, none of the .exp files matched. print "*** $name failed ($mid) ***\n"; push(@failures, sprintf("%-40s ($mid)", "$fullname")); $num_failures{$mid}++; if ($looptillfail == 1) { print "Failure encountered, stopping to loop\n"; exit 1 } } sub do_one_test($$) { my ($dir, $vgtest) = @_; $vgtest =~ /^(.*)\.vgtest/; my $name = $1; my $fullname = "$dir/$name"; # Pull any extra options (for example, --sanity-level=4) # from $EXTRA_REGTEST_OPTS. my $maybe_extraopts = $ENV{"EXTRA_REGTEST_OPTS"}; my $extraopts = $maybe_extraopts ? $maybe_extraopts : ""; read_vgtest_file($vgtest); if (defined $prereq) { my $prereq_res = system("/bin/sh", "-c", $prereq); if (0 == $prereq_res) { # Do nothing (ie. continue with the test) } elsif (256 == $prereq_res) { # Nb: weird Perl-ism -- exit code of '1' is seen by Perl as 256... # Prereq failed, skip. printf("%-16s (skipping, prereq failed: $prereq)\n", "$name:"); return; } else { # Bad prereq; abort. $prereq_res /= 256; die "prereq returned $prereq_res: $prereq\n"; } } if (defined $progB) { # Collect environment variables, if any. my $envBvars = ""; foreach my $e (@envB) { $envBvars = "$envBvars $e"; } # If there is a progB, let's start it in background: printf("%-16s valgrind $extraopts $vgopts $prog $args (progB: $progB $argsB)\n", "$name:"); # progB.done used to detect child has finished. See below. # Note: redirection of stdout and stderr is before $progB to allow argsB # to e.g. redirect stdoutB to stderrB if (defined $stdinB) { mysystem("(rm -f progB.done;" . " < $stdinB > $name.stdoutB.out 2> $name.stderrB.out" . " $envBvars $progB $argsB;" . "touch progB.done) &"); } else { mysystem("(rm -f progB.done;" . " > $name.stdoutB.out 2> $name.stderrB.out" . "$envBvars $progB $argsB;" . "touch progB.done) &"); } } else { printf("%-16s valgrind $extraopts $vgopts $prog $args\n", "$name:"); } # Collect environment variables, if any. my $envvars = ""; foreach my $e (@env) { $envvars = "$envvars $e"; } # Pass the appropriate --tool option for the directory (can be overridden # by an "args:" line, though). my $tool=determine_tool(); if (defined $outer_valgrind ) { # in an outer-inner setup, only set VALGRIND_LIB_INNER mysystem( "$envvars VALGRIND_LIB_INNER=$valgrind_lib " . "$outer_valgrind " . "--tool=" . $outer_tool . " " . "--log-file=" . "$name.outer.log " . "$run_outer_args " . "$valgrind --command-line-only=yes --memcheck:leak-check=no " . "--sim-hints=no-inner-prefix " . "--tool=$tool $extraopts $vgopts " . "$prog $args > $name.stdout.out 2> $name.stderr.out"); } else { # Set both VALGRIND_LIB and VALGRIND_LIB_INNER in case this Valgrind # was configured with --enable-inner. mysystem( "$envvars VALGRIND_LIB=$valgrind_lib VALGRIND_LIB_INNER=$valgrind_lib " . "$valgrind --command-line-only=yes --memcheck:leak-check=no " . "--tool=$tool $extraopts $vgopts " . "$prog $args > $name.stdout.out 2> $name.stderr.out"); } # Filter stdout if (defined $stdout_filter) { $stdout_filter_args = $name if (! defined $stdout_filter_args); mysystem("$stdout_filter $stdout_filter_args < $name.stdout.out > $tmp"); filtered_rename($tmp, "$name.stdout.out"); } # Find all the .stdout.exp files. If none, use /dev/null. my @stdout_exps = <$name.stdout.exp*>; @stdout_exps = ( "/dev/null" ) if (0 == scalar @stdout_exps); do_diffs($fullname, $name, "stdout", \@stdout_exps); # Filter stderr $stderr_filter_args = $name if (! defined $stderr_filter_args); mysystem("$stderr_filter $stderr_filter_args < $name.stderr.out > $tmp"); filtered_rename($tmp, "$name.stderr.out"); # Find all the .stderr.exp files. At least one must exist. my @stderr_exps = <$name.stderr.exp*>; (0 != scalar @stderr_exps) or die "Could not find `$name.stderr.exp*'\n"; do_diffs($fullname, $name, "stderr", \@stderr_exps); if (defined $progB) { # wait for the child to be finished # tried things such as: # wait; # $SIG{CHLD} = sub { wait }; # but nothing worked: # e.g. running mssnapshot.vgtest in a loop failed from time to time # due to some missing output (not yet written?). # So, we search progB.done during max 100 times 100 millisecond. my $count; for ($count = 1; $count <= 100; $count++) { (-f "progB.done") or select(undef, undef, undef, 0.100); } # Filter stdout if (defined $stdoutB_filter) { $stdoutB_filter_args = $name if (! defined $stdoutB_filter_args); mysystem("$stdoutB_filter $stdoutB_filter_args < $name.stdoutB.out > $tmp"); filtered_rename($tmp, "$name.stdoutB.out"); } # Find all the .stdoutB.exp files. If none, use /dev/null. my @stdoutB_exps = <$name.stdoutB.exp*>; @stdoutB_exps = ( "/dev/null" ) if (0 == scalar @stdoutB_exps); do_diffs($fullname, $name, "stdoutB", \@stdoutB_exps); # Filter stderr $stderrB_filter_args = $name if (! defined $stderrB_filter_args); mysystem("$stderrB_filter $stderrB_filter_args < $name.stderrB.out > $tmp"); filtered_rename($tmp, "$name.stderrB.out"); # Find all the .stderrB.exp files. At least one must exist. my @stderrB_exps = <$name.stderrB.exp*>; (0 != scalar @stderrB_exps) or die "Could not find `$name.stderrB.exp*'\n"; do_diffs($fullname, $name, "stderrB", \@stderrB_exps); } # Maybe do post-test check if (defined $post) { if (mysystem("$post > $name.post.out") != 0) { print("post check failed: $post\n"); $num_failures{"post"}++; } else { # Find all the .post.exp files. If none, use /dev/null. my @post_exps = <$name.post.exp*>; @post_exps = ( "/dev/null" ) if (0 == scalar @post_exps); do_diffs($fullname, $name, "post", \@post_exps); } } if (defined $cleanup) { (system("$cleanup") == 0) or print("(cleanup operation failed: $cleanup)\n"); } $num_tests_done++; } #---------------------------------------------------------------------------- # Test one directory (and any subdirs) #---------------------------------------------------------------------------- sub test_one_dir($$); # forward declaration sub test_one_dir($$) { my ($dir, $prev_dirs) = @_; $dir =~ s/\/$//; # trim a trailing '/' # Ignore dirs into which we should not recurse. if ($dir =~ /^(BitKeeper|CVS|SCCS|docs|doc)$/) { return; } (-x "$tests_dir/tests/arch_test") or die "vg_regtest: 'arch_test' is missing. Did you forget to 'make check'?\n"; # Ignore any dir whose name matches that of an architecture which is not # the architecture we are running on. Eg. when running on x86, ignore # ppc/ directories ('arch_test' returns 1 for this case). Likewise for # the OS and platform. # Nb: weird Perl-ism -- exit code of '1' is seen by Perl as 256... if (256 == system("$tests_dir/tests/arch_test $dir")) { return; } if (256 == system("$tests_dir/tests/os_test $dir")) { return; } if ($dir =~ /(\w+)-(\w+)/ && 256 == system("sh $tests_dir/tests/platform_test $1 $2")) { return; } chdir($dir) or die "Could not change into $dir\n"; # Nb: Don't prepend a '/' to the base directory my $full_dir = $prev_dirs . ($prev_dirs eq "" ? "" : "/") . $dir; my $dashes = "-" x (50 - length $full_dir); my @fs = glob "*"; my $found_tests = (0 != (grep { $_ =~ /\.vgtest$/ } @fs)); if ($found_tests) { print "-- Running tests in $full_dir $dashes\n"; } foreach my $f (@fs) { if (-d $f) { test_one_dir($f, $full_dir); } elsif ($f =~ /\.vgtest$/) { do_one_test($full_dir, $f); } } if ($found_tests) { print "-- Finished tests in $full_dir $dashes\n"; } chdir(".."); } #---------------------------------------------------------------------------- # Summarise results #---------------------------------------------------------------------------- sub plural($) { return ( $_[0] == 1 ? "" : "s" ); } sub summarise_results { my $x = ( $num_tests_done == 1 ? "test" : "tests" ); printf("\n== %d test%s, %d stderr failure%s, %d stdout failure%s, " . "%d stderrB failure%s, %d stdoutB failure%s, " . "%d post failure%s ==\n", $num_tests_done, plural($num_tests_done), $num_failures{"stderr"}, plural($num_failures{"stderr"}), $num_failures{"stdout"}, plural($num_failures{"stdout"}), $num_failures{"stderrB"}, plural($num_failures{"stderrB"}), $num_failures{"stdoutB"}, plural($num_failures{"stdoutB"}), $num_failures{"post"}, plural($num_failures{"post"})); foreach my $failure (@failures) { print "$failure\n"; } print "\n"; } #---------------------------------------------------------------------------- # main(), sort of #---------------------------------------------------------------------------- sub warn_about_EXTRA_REGTEST_OPTS() { print "WARNING: \$EXTRA_REGTEST_OPTS is set. You probably don't want\n"; print "to run the regression tests with it set, unless you are doing some\n"; print "strange experiment, and/or you really know what you are doing.\n"; print "\n"; } # nuke VALGRIND_OPTS $ENV{"VALGRIND_OPTS"} = ""; if ($ENV{"EXTRA_REGTEST_OPTS"}) { print "\n"; warn_about_EXTRA_REGTEST_OPTS(); } my @fs = process_command_line(); while (1) { # we will exit after one loop, unless looptillfail foreach my $f (@fs) { if (-d $f) { test_one_dir($f, ""); } else { # Allow the .vgtest suffix to be given or omitted if ($f =~ /.vgtest$/ && -r $f) { # do nothing } elsif (-r "$f.vgtest") { $f = "$f.vgtest"; } else { die "`$f' neither a directory nor a readable test file/name\n" } my $dir = `dirname $f`; chomp $dir; my $file = `basename $f`; chomp $file; chdir($dir) or die "Could not change into $dir\n"; do_one_test($dir, $file); } chdir($tests_dir); } if ($looptillfail == 0) { last; } } summarise_results(); if ($ENV{"EXTRA_REGTEST_OPTS"}) { warn_about_EXTRA_REGTEST_OPTS(); } if (0 == $num_failures{"stdout"} && 0 == $num_failures{"stderr"} && 0 == $num_failures{"stdoutB"} && 0 == $num_failures{"stderrB"} && 0 == $num_failures{"post"}) { exit 0; } else { exit 1; } ##--------------------------------------------------------------------## ##--- end vg_regtest ---## ##--------------------------------------------------------------------##