njn | 9fb16f5 | 2003-04-23 17:47:13 +0000 | [diff] [blame] | 1 | #! @PERL@ |
njn | a217f3d | 2002-09-27 08:26:27 +0000 | [diff] [blame] | 2 | ##--------------------------------------------------------------------## |
| 3 | ##--- Valgrind regression testing script vg_regtest ---## |
| 4 | ##--------------------------------------------------------------------## |
njn | c2e7f48 | 2002-09-27 08:44:17 +0000 | [diff] [blame] | 5 | |
njn | b9c427c | 2004-12-01 14:14:42 +0000 | [diff] [blame] | 6 | # This file is part of Valgrind, a dynamic binary instrumentation |
| 7 | # framework. |
njn | c2e7f48 | 2002-09-27 08:44:17 +0000 | [diff] [blame] | 8 | # |
njn | 0e1b514 | 2003-04-15 14:58:06 +0000 | [diff] [blame] | 9 | # Copyright (C) 2003 Nicholas Nethercote |
njn | 2bc1012 | 2005-05-08 02:10:27 +0000 | [diff] [blame] | 10 | # njn@valgrind.org |
njn | c2e7f48 | 2002-09-27 08:44:17 +0000 | [diff] [blame] | 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 | #---------------------------------------------------------------------------- |
njn | a217f3d | 2002-09-27 08:26:27 +0000 | [diff] [blame] | 30 | # usage: vg_regtest [options] <dirs | files> |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 31 | # |
njn | a217f3d | 2002-09-27 08:26:27 +0000 | [diff] [blame] | 32 | # Options: |
njn | a217f3d | 2002-09-27 08:26:27 +0000 | [diff] [blame] | 33 | # --all: run tests in all subdirs |
njn | c2e7f48 | 2002-09-27 08:44:17 +0000 | [diff] [blame] | 34 | # --valgrind: valgrind to use. Default is one built from this source tree. |
njn | a217f3d | 2002-09-27 08:26:27 +0000 | [diff] [blame] | 35 | # |
njn | 4ba5a79 | 2002-09-30 10:23:54 +0000 | [diff] [blame] | 36 | # The easiest way is to run all tests in valgrind/ with (assuming you installed |
| 37 | # in $PREFIX): |
| 38 | # |
| 39 | # $PREFIX/bin/vg_regtest --all |
| 40 | # |
njn | a217f3d | 2002-09-27 08:26:27 +0000 | [diff] [blame] | 41 | # You can specify individual files to test, or whole directories, or both. |
jsgf | 855d93d | 2003-10-13 22:26:55 +0000 | [diff] [blame] | 42 | # Directories are traversed recursively, except for ones named, for example, |
| 43 | # CVS/ or docs/. |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 44 | # |
| 45 | # Each test is defined in a file <test>.vgtest, containing one or more of the |
njn | a217f3d | 2002-09-27 08:26:27 +0000 | [diff] [blame] | 46 | # following lines, in any order: |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 47 | # - prog: <prog to run> (compulsory) |
| 48 | # - args: <args for prog> (default: none) |
| 49 | # - vgopts: <Valgrind options> (default: none) |
| 50 | # - stdout_filter: <filter to run stdout through> (default: none) |
njn | a217f3d | 2002-09-27 08:26:27 +0000 | [diff] [blame] | 51 | # - stderr_filter: <filter to run stderr through> (default: ./filter_stderr) |
nethercote | c5e1d80 | 2004-11-18 12:48:17 +0000 | [diff] [blame] | 52 | # - prereq: <prerequisite command> (default: none) |
nethercote | 64bc5af | 2004-11-18 11:57:00 +0000 | [diff] [blame] | 53 | # - cleanup: <post-test cleanup cmd to run> (default: none) |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 54 | # |
njn | a217f3d | 2002-09-27 08:26:27 +0000 | [diff] [blame] | 55 | # Note that filters are necessary for stderr results to filter out things that |
| 56 | # always change, eg. process id numbers. |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 57 | # |
nethercote | 4592db6 | 2004-02-29 01:31:09 +0000 | [diff] [blame] | 58 | # Expected stdout (filtered) is kept in <test>.stdout.exp[0-9]? (can be more |
| 59 | # than one expected output). It can be missing if it would be empty. Expected |
| 60 | # stderr (filtered) is kept in <test>.stderr.exp[0-9]?. |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 61 | # |
nethercote | c5e1d80 | 2004-11-18 12:48:17 +0000 | [diff] [blame] | 62 | # The prerequisite command, if present, must return 0 otherwise the test is |
| 63 | # skipped. |
| 64 | # |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 65 | # If results don't match, the output can be found in <test>.std<strm>.out, |
nethercote | 4592db6 | 2004-02-29 01:31:09 +0000 | [diff] [blame] | 66 | # and the diff between expected and actual in <test>.std<strm>.diff[0-9]?. |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 67 | # |
nethercote | 137bc55 | 2003-11-14 17:47:54 +0000 | [diff] [blame] | 68 | # Notes on adding regression tests for a new tool are in |
| 69 | # coregrind/docs/coregrind_tools.html. |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 70 | #---------------------------------------------------------------------------- |
| 71 | |
njn | 9fb16f5 | 2003-04-23 17:47:13 +0000 | [diff] [blame] | 72 | use warnings; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 73 | use strict; |
| 74 | |
| 75 | #---------------------------------------------------------------------------- |
| 76 | # Global vars |
| 77 | #---------------------------------------------------------------------------- |
njn | d8ced86 | 2003-04-08 00:47:05 +0000 | [diff] [blame] | 78 | my $usage="vg_regtest [--all, --valgrind]\n"; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 79 | |
| 80 | my $tmp="vg_regtest.tmp.$$"; |
| 81 | |
| 82 | # Test variables |
| 83 | my $vgopts; # valgrind options |
| 84 | my $prog; # test prog |
| 85 | my $args; # test prog args |
| 86 | my $stdout_filter; # filter program to run stdout results file through |
| 87 | my $stderr_filter; # filter program to run stderr results file through |
nethercote | c5e1d80 | 2004-11-18 12:48:17 +0000 | [diff] [blame] | 88 | my $prereq; # prerequisite test to satisfy before running test |
nethercote | 64bc5af | 2004-11-18 11:57:00 +0000 | [diff] [blame] | 89 | my $cleanup; # cleanup command to run |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 90 | |
| 91 | my @failures; # List of failed tests |
| 92 | |
njn | 9fb16f5 | 2003-04-23 17:47:13 +0000 | [diff] [blame] | 93 | my $num_tests_done = 0; |
| 94 | my %num_failures = (stderr => 0, stdout => 0); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 95 | |
njn | 71fe3e6 | 2003-04-23 21:48:20 +0000 | [diff] [blame] | 96 | # Default valgrind to use is this build tree's (uninstalled) one |
njn | 71fe3e6 | 2003-04-23 21:48:20 +0000 | [diff] [blame] | 97 | my $valgrind = "./coregrind/valgrind"; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 98 | |
| 99 | chomp(my $tests_dir = `pwd`); |
| 100 | |
| 101 | # default filter is the one named "filter_stderr" in the test's directory |
| 102 | my $default_stderr_filter = "filter_stderr"; |
| 103 | |
| 104 | |
| 105 | #---------------------------------------------------------------------------- |
| 106 | # Process command line, setup |
| 107 | #---------------------------------------------------------------------------- |
| 108 | |
| 109 | # If $prog is a relative path, it prepends $dir to it. Useful for two reasons: |
| 110 | # |
| 111 | # 1. Can prepend "." onto programs to avoid trouble with users who don't have |
| 112 | # "." in their path (by making $dir = ".") |
| 113 | # 2. Can prepend the current dir to make the command absolute to avoid |
| 114 | # subsequent trouble when we change directories. |
| 115 | # |
| 116 | # Also checks the program exists and is executable. |
nethercote | f4928da | 2004-06-15 10:54:40 +0000 | [diff] [blame] | 117 | sub validate_program ($$$$) |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 118 | { |
nethercote | f4928da | 2004-06-15 10:54:40 +0000 | [diff] [blame] | 119 | my ($dir, $prog, $must_exist, $must_be_executable) = @_; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 120 | |
| 121 | # If absolute path, leave it alone. If relative, make it |
| 122 | # absolute -- by prepending current dir -- so we can change |
| 123 | # dirs and still use it. |
| 124 | $prog = "$dir/$prog" if ($prog !~ /^\//); |
nethercote | f4928da | 2004-06-15 10:54:40 +0000 | [diff] [blame] | 125 | if ($must_exist) { |
| 126 | (-f $prog) or die "vg_regtest: `$prog' not found or not a file ($dir)\n"; |
| 127 | } |
njn | 71fe3e6 | 2003-04-23 21:48:20 +0000 | [diff] [blame] | 128 | if ($must_be_executable) { |
nethercote | f4928da | 2004-06-15 10:54:40 +0000 | [diff] [blame] | 129 | (-x $prog) or die "vg_regtest: `$prog' not executable ($dir)\n"; |
njn | 71fe3e6 | 2003-04-23 21:48:20 +0000 | [diff] [blame] | 130 | } |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 131 | |
| 132 | return $prog; |
| 133 | } |
| 134 | |
| 135 | sub process_command_line() |
| 136 | { |
| 137 | my $alldirs = 0; |
| 138 | my @fs; |
| 139 | |
| 140 | for my $arg (@ARGV) { |
| 141 | if ($arg =~ /^-/) { |
njn | d8ced86 | 2003-04-08 00:47:05 +0000 | [diff] [blame] | 142 | if ($arg =~ /^--all$/) { |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 143 | $alldirs = 1; |
| 144 | } elsif ($arg =~ /^--valgrind=(.*)$/) { |
| 145 | $valgrind = $1; |
| 146 | } else { |
| 147 | die $usage; |
| 148 | } |
| 149 | } else { |
| 150 | push(@fs, $arg); |
| 151 | } |
| 152 | } |
nethercote | f4928da | 2004-06-15 10:54:40 +0000 | [diff] [blame] | 153 | $valgrind = validate_program($tests_dir, $valgrind, 1, 0); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 154 | |
| 155 | if ($alldirs) { |
| 156 | @fs = (); |
| 157 | foreach my $f (glob "*") { |
| 158 | push(@fs, $f) if (-d $f); |
| 159 | } |
| 160 | } |
| 161 | |
| 162 | (0 != @fs) or die "No test files or directories specified\n"; |
| 163 | |
| 164 | return @fs; |
| 165 | } |
| 166 | |
| 167 | #---------------------------------------------------------------------------- |
| 168 | # Read a .vgtest file |
| 169 | #---------------------------------------------------------------------------- |
| 170 | sub read_vgtest_file($) |
| 171 | { |
| 172 | my ($f) = @_; |
| 173 | |
| 174 | # Defaults. |
nethercote | c5e1d80 | 2004-11-18 12:48:17 +0000 | [diff] [blame] | 175 | ($vgopts, $prog, $args, $stdout_filter, $stderr_filter, $prereq, $cleanup) |
nethercote | c1f8ad9 | 2004-04-17 17:25:08 +0000 | [diff] [blame] | 176 | = ("", undef, "", undef, undef, undef, undef); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 177 | |
| 178 | # Every test directory must have a "filter_stderr" |
nethercote | f4928da | 2004-06-15 10:54:40 +0000 | [diff] [blame] | 179 | $stderr_filter = validate_program(".", $default_stderr_filter, 1, 1); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 180 | |
| 181 | open(INPUTFILE, "< $f") || die "File $f not openable\n"; |
| 182 | |
| 183 | while (my $line = <INPUTFILE>) { |
sewardj | b5f6f51 | 2005-03-10 23:59:00 +0000 | [diff] [blame] | 184 | if ($line =~ /^\s*#/ || $line =~ /^\s*$/) { |
| 185 | next; |
| 186 | } elsif ($line =~ /^\s*vgopts:\s*(.*)$/) { |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 187 | $vgopts = $1; |
| 188 | } elsif ($line =~ /^\s*prog:\s*(.*)$/) { |
nethercote | f4928da | 2004-06-15 10:54:40 +0000 | [diff] [blame] | 189 | $prog = validate_program(".", $1, 0, 0); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 190 | } elsif ($line =~ /^\s*args:\s*(.*)$/) { |
| 191 | $args = $1; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 192 | } elsif ($line =~ /^\s*stdout_filter:\s*(.*)$/) { |
nethercote | f4928da | 2004-06-15 10:54:40 +0000 | [diff] [blame] | 193 | $stdout_filter = validate_program(".", $1, 1, 1); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 194 | } elsif ($line =~ /^\s*stderr_filter:\s*(.*)$/) { |
nethercote | f4928da | 2004-06-15 10:54:40 +0000 | [diff] [blame] | 195 | $stderr_filter = validate_program(".", $1, 1, 1); |
nethercote | c5e1d80 | 2004-11-18 12:48:17 +0000 | [diff] [blame] | 196 | } elsif ($line =~ /^\s*prereq:\s*(.*)$/) { |
| 197 | $prereq = $1; |
nethercote | 64bc5af | 2004-11-18 11:57:00 +0000 | [diff] [blame] | 198 | } elsif ($line =~ /^\s*cleanup:\s*(.*)$/) { |
| 199 | $cleanup = $1; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 200 | } else { |
| 201 | die "Bad line in $f: $line\n"; |
| 202 | } |
| 203 | } |
| 204 | close(INPUTFILE); |
| 205 | |
| 206 | if (!defined $prog) { |
nethercote | f4928da | 2004-06-15 10:54:40 +0000 | [diff] [blame] | 207 | $prog = ""; # allow no prog for testing error and --help cases |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 208 | } |
| 209 | } |
| 210 | |
| 211 | #---------------------------------------------------------------------------- |
| 212 | # Do one test |
| 213 | #---------------------------------------------------------------------------- |
| 214 | # Since most of the program time is spent in system() calls, need this to |
| 215 | # propagate a Ctrl-C enabling us to quit. |
| 216 | sub mysystem($) |
| 217 | { |
| 218 | (system($_[0]) != 2) or exit 1; # 2 is SIGINT |
| 219 | } |
| 220 | |
nethercote | 137bc55 | 2003-11-14 17:47:54 +0000 | [diff] [blame] | 221 | # from a directory name like "/foo/cachesim/tests/" determine the tool name |
| 222 | sub determine_tool() |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame] | 223 | { |
| 224 | my $dir = `pwd`; |
nethercote | 137bc55 | 2003-11-14 17:47:54 +0000 | [diff] [blame] | 225 | $dir =~ /.*\/([^\/]+)\/tests.*/; # foo/tool_name/tests/foo |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame] | 226 | return $1; |
| 227 | } |
| 228 | |
nethercote | 4592db6 | 2004-02-29 01:31:09 +0000 | [diff] [blame] | 229 | # Compare output against expected output; it should match at least one of |
| 230 | # them. |
| 231 | sub do_diffs($$$$) |
| 232 | { |
| 233 | my ($fullname, $name, $mid, $f_exps) = @_; |
| 234 | |
| 235 | for my $f_exp (@$f_exps) { |
| 236 | (-r $f_exp) or die "Could not read `$f_exp'\n"; |
| 237 | |
| 238 | my $n = ""; |
| 239 | if ($f_exp =~ /.*\.exp(\d?)/) { |
| 240 | $n = $1; |
| 241 | } else { |
| 242 | $n = ""; |
| 243 | ($f_exp eq "/dev/null") or die "Unexpected .exp file: $f_exp\n"; |
| 244 | } |
| 245 | |
| 246 | #print("diff -C0 $f_exp $name.$mid.out > $name.$mid.diff$n\n"); |
| 247 | mysystem("diff -C0 $f_exp $name.$mid.out > $name.$mid.diff$n"); |
| 248 | |
| 249 | if (not -s "$name.$mid.diff$n") { |
| 250 | # A match; remove .out and any previously created .diff files. |
| 251 | unlink("$name.$mid.out"); |
| 252 | unlink(<$name.$mid.diff*>); |
| 253 | return; |
| 254 | } |
| 255 | } |
| 256 | # If we reach here, none of the .exp files matched. |
| 257 | print "*** $name failed ($mid) ***\n"; |
| 258 | push(@failures, sprintf("%-40s ($mid)", "$fullname")); |
| 259 | $num_failures{$mid}++; |
| 260 | } |
| 261 | |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 262 | sub do_one_test($$) |
| 263 | { |
| 264 | my ($dir, $vgtest) = @_; |
| 265 | $vgtest =~ /^(.*)\.vgtest/; |
| 266 | my $name = $1; |
| 267 | my $fullname = "$dir/$name"; |
| 268 | |
| 269 | read_vgtest_file($vgtest); |
| 270 | |
nethercote | c5e1d80 | 2004-11-18 12:48:17 +0000 | [diff] [blame] | 271 | if (defined $prereq) { |
| 272 | if (system("$prereq") != 0) { |
| 273 | printf("%-16s (skipping, prereq failed: $prereq)\n", "$name:"); |
nethercote | 781bed4 | 2004-10-19 16:56:41 +0000 | [diff] [blame] | 274 | return; |
| 275 | } |
nethercote | b1affa8 | 2004-01-19 19:14:18 +0000 | [diff] [blame] | 276 | } |
| 277 | |
njn | db3c469 | 2002-10-04 10:03:34 +0000 | [diff] [blame] | 278 | printf("%-16s valgrind $vgopts $prog $args\n", "$name:"); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 279 | |
nethercote | 137bc55 | 2003-11-14 17:47:54 +0000 | [diff] [blame] | 280 | # Pass the appropriate --tool option for the directory (can be overridden |
sewardj | b5f6f51 | 2005-03-10 23:59:00 +0000 | [diff] [blame] | 281 | # by an "args:" line, though). |
nethercote | 137bc55 | 2003-11-14 17:47:54 +0000 | [diff] [blame] | 282 | my $tool=determine_tool(); |
njn | 6a32942 | 2005-03-12 20:38:13 +0000 | [diff] [blame] | 283 | mysystem("VALGRINDLIB=$tests_dir/.in_place $valgrind --command-line-only=yes --memcheck:leak-check=no --addrcheck:leak-check=no --tool=$tool $vgopts $prog $args > $name.stdout.out 2> $name.stderr.out"); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 284 | |
| 285 | if (defined $stdout_filter) { |
| 286 | mysystem("$stdout_filter < $name.stdout.out > $tmp"); |
| 287 | rename($tmp, "$name.stdout.out"); |
| 288 | } |
| 289 | |
| 290 | mysystem("$stderr_filter < $name.stderr.out > $tmp"); |
| 291 | rename($tmp, "$name.stderr.out"); |
| 292 | |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 293 | |
nethercote | 4592db6 | 2004-02-29 01:31:09 +0000 | [diff] [blame] | 294 | # Find all the .stdout.exp files. If none, use /dev/null. |
| 295 | my @stdout_exps = <$name.stdout.exp*>; |
| 296 | @stdout_exps = ( "/dev/null" ) if (0 == scalar @stdout_exps); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 297 | |
nethercote | 4592db6 | 2004-02-29 01:31:09 +0000 | [diff] [blame] | 298 | # Find all the .stderr.exp files. $name.stderr.exp must exist. |
| 299 | my @stderr_exps = <$name.stderr.exp*>; |
| 300 | (-r "$name.stderr.exp") or die "Could not read `$name.stderr.exp'\n"; |
| 301 | |
| 302 | do_diffs($fullname, $name, "stdout", \@stdout_exps); |
| 303 | do_diffs($fullname, $name, "stderr", \@stderr_exps); |
nethercote | c1f8ad9 | 2004-04-17 17:25:08 +0000 | [diff] [blame] | 304 | |
nethercote | 64bc5af | 2004-11-18 11:57:00 +0000 | [diff] [blame] | 305 | if (defined $cleanup) { |
| 306 | (system("$cleanup") == 0) or |
| 307 | print("(cleanup operation failed: $cleanup)\n"); |
nethercote | c1f8ad9 | 2004-04-17 17:25:08 +0000 | [diff] [blame] | 308 | } |
| 309 | |
njn | 9fb16f5 | 2003-04-23 17:47:13 +0000 | [diff] [blame] | 310 | $num_tests_done++; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 311 | } |
| 312 | |
| 313 | #---------------------------------------------------------------------------- |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame] | 314 | # Test one directory (and any subdirs) |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 315 | #---------------------------------------------------------------------------- |
njn | db3c469 | 2002-10-04 10:03:34 +0000 | [diff] [blame] | 316 | sub test_one_dir($$); # forward declaration |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame] | 317 | |
njn | db3c469 | 2002-10-04 10:03:34 +0000 | [diff] [blame] | 318 | sub test_one_dir($$) |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 319 | { |
njn | db3c469 | 2002-10-04 10:03:34 +0000 | [diff] [blame] | 320 | my ($dir, $prev_dirs) = @_; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 321 | $dir =~ s/\/$//; # trim a trailing '/' |
| 322 | |
nethercote | 362c0d2 | 2004-11-18 18:21:56 +0000 | [diff] [blame] | 323 | # Ignore dirs into which we should not recurse. |
mueller | 92f0b80 | 2003-11-19 00:55:32 +0000 | [diff] [blame] | 324 | if ($dir =~ /^(BitKeeper|CVS|SCCS|docs|doc)$/) { return; } |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame] | 325 | |
nethercote | 362c0d2 | 2004-11-18 18:21:56 +0000 | [diff] [blame] | 326 | # Ignore any dir whose name matches that of an architecture which is not |
| 327 | # the architecture we are running on (eg. when running on x86, ignore ppc/ |
| 328 | # directories). |
| 329 | # Nb: weird Perl-ism -- exit code of '1' is seen by Perl as 256... |
| 330 | if (256 == system("$tests_dir/tests/cputest $dir")) { return; } |
| 331 | |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 332 | chdir($dir) or die "Could not change into $dir\n"; |
| 333 | |
njn | 584eaac | 2002-10-04 15:30:48 +0000 | [diff] [blame] | 334 | # Nb: Don't prepend a '/' to the base directory |
| 335 | my $full_dir = $prev_dirs . ($prev_dirs eq "" ? "" : "/") . $dir; |
njn | db3c469 | 2002-10-04 10:03:34 +0000 | [diff] [blame] | 336 | my $dashes = "-" x (50 - length $full_dir); |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame] | 337 | |
njn | db3c469 | 2002-10-04 10:03:34 +0000 | [diff] [blame] | 338 | my @fs = glob "*"; |
| 339 | my @vgtests = grep { $_ =~ /\.vgtest$/ } @fs; |
| 340 | my $found_tests = (0 != (grep { $_ =~ /\.vgtest$/ } @fs)); |
| 341 | |
| 342 | if ($found_tests) { |
| 343 | print "-- Running tests in $full_dir $dashes\n"; |
njn | db3c469 | 2002-10-04 10:03:34 +0000 | [diff] [blame] | 344 | } |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame] | 345 | foreach my $f (@fs) { |
| 346 | if (-d $f) { |
njn | db3c469 | 2002-10-04 10:03:34 +0000 | [diff] [blame] | 347 | test_one_dir($f, $full_dir); |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame] | 348 | } elsif ($f =~ /\.vgtest$/) { |
njn | db3c469 | 2002-10-04 10:03:34 +0000 | [diff] [blame] | 349 | do_one_test($full_dir, $f); |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame] | 350 | } |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 351 | } |
njn | db3c469 | 2002-10-04 10:03:34 +0000 | [diff] [blame] | 352 | if ($found_tests) { |
| 353 | print "-- Finished tests in $full_dir $dashes\n"; |
| 354 | } |
| 355 | |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 356 | chdir(".."); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 357 | } |
| 358 | |
| 359 | #---------------------------------------------------------------------------- |
| 360 | # Summarise results |
| 361 | #---------------------------------------------------------------------------- |
njn | 9fb16f5 | 2003-04-23 17:47:13 +0000 | [diff] [blame] | 362 | sub plural($) |
| 363 | { |
| 364 | return ( $_[0] == 1 ? "" : "s" ); |
| 365 | } |
| 366 | |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 367 | sub summarise_results |
| 368 | { |
njn | d8ced86 | 2003-04-08 00:47:05 +0000 | [diff] [blame] | 369 | my $x = ( $num_tests_done == 1 ? "test" : "tests" ); |
njn | d8ced86 | 2003-04-08 00:47:05 +0000 | [diff] [blame] | 370 | |
njn | 9fb16f5 | 2003-04-23 17:47:13 +0000 | [diff] [blame] | 371 | printf("\n== %d test%s, %d stderr failure%s, %d stdout failure%s =================\n", |
| 372 | $num_tests_done, plural($num_tests_done), |
| 373 | $num_failures{"stderr"}, plural($num_failures{"stderr"}), |
| 374 | $num_failures{"stdout"}, plural($num_failures{"stdout"})); |
| 375 | |
| 376 | foreach my $failure (@failures) { |
| 377 | print "$failure\n"; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 378 | } |
njn | 9fb16f5 | 2003-04-23 17:47:13 +0000 | [diff] [blame] | 379 | print "\n"; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 380 | } |
| 381 | |
| 382 | #---------------------------------------------------------------------------- |
| 383 | # main(), sort of |
| 384 | #---------------------------------------------------------------------------- |
| 385 | |
daywalker | bb93698 | 2003-04-23 16:52:06 +0000 | [diff] [blame] | 386 | # nuke VALGRIND_OPTS |
| 387 | $ENV{"VALGRIND_OPTS"} = ""; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 388 | |
| 389 | my @fs = process_command_line(); |
| 390 | foreach my $f (@fs) { |
| 391 | if (-d $f) { |
njn | 584eaac | 2002-10-04 15:30:48 +0000 | [diff] [blame] | 392 | test_one_dir($f, ""); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 393 | } else { |
| 394 | # Allow the .vgtest suffix to be given or omitted |
| 395 | if ($f =~ /.vgtest$/ && -r $f) { |
| 396 | # do nothing |
| 397 | } elsif (-r "$f.vgtest") { |
| 398 | $f = "$f.vgtest"; |
| 399 | } else { |
| 400 | die "`$f' neither a directory nor a readable test file/name\n" |
| 401 | } |
| 402 | my $dir = `dirname $f`; chomp $dir; |
| 403 | my $file = `basename $f`; chomp $file; |
| 404 | chdir($dir) or die "Could not change into $dir\n"; |
| 405 | do_one_test($dir, $file); |
| 406 | chdir($tests_dir); |
| 407 | } |
| 408 | } |
| 409 | summarise_results(); |
| 410 | |
nethercote | ab42219 | 2004-03-01 08:27:37 +0000 | [diff] [blame] | 411 | if (0 == $num_failures{"stdout"} && 0 == $num_failures{"stderr"}) { |
| 412 | exit 0; |
| 413 | } else { |
| 414 | exit 1; |
| 415 | } |
| 416 | |
njn | c2e7f48 | 2002-09-27 08:44:17 +0000 | [diff] [blame] | 417 | ##--------------------------------------------------------------------## |
| 418 | ##--- end vg_regtest ---## |
| 419 | ##--------------------------------------------------------------------## |