njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 1 | #! /usr/bin/perl -w |
| 2 | # |
| 3 | # Valgrind regression testing script. |
| 4 | # |
| 5 | # Each test is defined in a file <test>.vgtest, containing one or more of the |
| 6 | # following lines: |
| 7 | # - prog: <prog to run> (compulsory) |
| 8 | # - args: <args for prog> (default: none) |
| 9 | # - vgopts: <Valgrind options> (default: none) |
| 10 | # - stdout_filter: <filter to run stdout through> (default: none) |
| 11 | # - stderr_filter: <filter to run stderr through> (default: filter_stderr) |
| 12 | # |
| 13 | # Also have "vgopts.hd:" for options to be only passed if --head true, and |
| 14 | # corresponding "vgopts.er" for --eraser. |
| 15 | # |
| 16 | # Expected results (filtered) are kept in <test>.stderr.exp and |
| 17 | # <test>.stdout.exp. The latter can be missing if it would be empty. |
| 18 | # |
| 19 | # If results don't match, the output can be found in <test>.std<strm>.out, |
| 20 | # and the diff between expected and actual in <test>.std<strm>.diff. |
| 21 | # |
| 22 | # usage: vg_regtest [options] <dirs | files> |
| 23 | # |
| 24 | # You can specify individual files to test, or whole directories, or both. |
| 25 | # |
| 26 | # Options: |
| 27 | # --head: use 1.0.X expected stderr results |
| 28 | # --eraser: use ERASER expected stderr results (default) |
| 29 | # --all: run tests in all subdirs |
| 30 | # --valgrind: valgrind to use. Default is one in this build tree. |
| 31 | # |
| 32 | # The difference between the 1.0.X and ERASER results is that ERASER gives |
| 33 | # shorter stack traces. The ERASER stderr results are kept in |
| 34 | # <test>.stderr.er. |
| 35 | #---------------------------------------------------------------------------- |
| 36 | # Adding a new tests subdirectory: |
| 37 | # - Add directory to valgrind/configure.in |
| 38 | # - Write a Makefile.am for it |
| 39 | # - Write a filter_stderr for it; it should always call |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame^] | 40 | # ../../tests/filter_stderr_basic as its first step |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 41 | # - Add test programs, .vgtest, .stderr.exp{,.hd}, .stdout.exp files |
| 42 | # |
| 43 | # Note that if you add new basis filters in tests/, if they call other basic |
| 44 | # filters, use the $dir trick to get the directory right as in filter_discards. |
| 45 | #---------------------------------------------------------------------------- |
| 46 | |
| 47 | use strict; |
| 48 | |
| 49 | #---------------------------------------------------------------------------- |
| 50 | # Global vars |
| 51 | #---------------------------------------------------------------------------- |
| 52 | my $usage="vg_regtest [--head|--eraser, --all]\n"; |
| 53 | |
| 54 | my $tmp="vg_regtest.tmp.$$"; |
| 55 | |
| 56 | # Test variables |
| 57 | my $vgopts; # valgrind options |
| 58 | my $prog; # test prog |
| 59 | my $args; # test prog args |
| 60 | my $stdout_filter; # filter program to run stdout results file through |
| 61 | my $stderr_filter; # filter program to run stderr results file through |
| 62 | |
| 63 | my @failures; # List of failed tests |
| 64 | |
| 65 | my $exp = ""; # --eraser is default |
| 66 | |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame^] | 67 | # Assumes we're in valgrind/ |
| 68 | my $valgrind = "bin/valgrind"; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 69 | |
| 70 | chomp(my $tests_dir = `pwd`); |
| 71 | |
| 72 | # default filter is the one named "filter_stderr" in the test's directory |
| 73 | my $default_stderr_filter = "filter_stderr"; |
| 74 | |
| 75 | |
| 76 | #---------------------------------------------------------------------------- |
| 77 | # Process command line, setup |
| 78 | #---------------------------------------------------------------------------- |
| 79 | |
| 80 | # If $prog is a relative path, it prepends $dir to it. Useful for two reasons: |
| 81 | # |
| 82 | # 1. Can prepend "." onto programs to avoid trouble with users who don't have |
| 83 | # "." in their path (by making $dir = ".") |
| 84 | # 2. Can prepend the current dir to make the command absolute to avoid |
| 85 | # subsequent trouble when we change directories. |
| 86 | # |
| 87 | # Also checks the program exists and is executable. |
| 88 | sub validate_program ($$) |
| 89 | { |
| 90 | my ($dir, $prog) = @_; |
| 91 | |
| 92 | # If absolute path, leave it alone. If relative, make it |
| 93 | # absolute -- by prepending current dir -- so we can change |
| 94 | # dirs and still use it. |
| 95 | $prog = "$dir/$prog" if ($prog !~ /^\//); |
| 96 | (-f $prog) or die "`$prog' not found or not a file ($dir)\n"; |
| 97 | (-x $prog) or die "`$prog' not found or not executable ($dir)\n"; |
| 98 | |
| 99 | return $prog; |
| 100 | } |
| 101 | |
| 102 | sub process_command_line() |
| 103 | { |
| 104 | my $alldirs = 0; |
| 105 | my @fs; |
| 106 | |
| 107 | for my $arg (@ARGV) { |
| 108 | if ($arg =~ /^-/) { |
| 109 | if ($arg =~ /^--head$/) { |
| 110 | $exp = ".hd"; |
| 111 | } elsif ($arg =~ /^--eraser$/) { |
| 112 | $exp = ""; |
| 113 | } elsif ($arg =~ /^--all$/) { |
| 114 | $alldirs = 1; |
| 115 | } elsif ($arg =~ /^--valgrind=(.*)$/) { |
| 116 | $valgrind = $1; |
| 117 | } else { |
| 118 | die $usage; |
| 119 | } |
| 120 | } else { |
| 121 | push(@fs, $arg); |
| 122 | } |
| 123 | } |
| 124 | $valgrind = validate_program($tests_dir, $valgrind); |
| 125 | |
| 126 | if ($alldirs) { |
| 127 | @fs = (); |
| 128 | foreach my $f (glob "*") { |
| 129 | push(@fs, $f) if (-d $f); |
| 130 | } |
| 131 | } |
| 132 | |
| 133 | (0 != @fs) or die "No test files or directories specified\n"; |
| 134 | |
| 135 | return @fs; |
| 136 | } |
| 137 | |
| 138 | #---------------------------------------------------------------------------- |
| 139 | # Read a .vgtest file |
| 140 | #---------------------------------------------------------------------------- |
| 141 | sub read_vgtest_file($) |
| 142 | { |
| 143 | my ($f) = @_; |
| 144 | |
| 145 | # Defaults. |
| 146 | ($vgopts, $prog, $args, $stdout_filter, $stderr_filter) = |
| 147 | ("", undef, "", undef, undef); |
| 148 | |
| 149 | # Every test directory must have a "filter_stderr" |
| 150 | $stderr_filter = validate_program(".", $default_stderr_filter); |
| 151 | |
| 152 | open(INPUTFILE, "< $f") || die "File $f not openable\n"; |
| 153 | |
| 154 | while (my $line = <INPUTFILE>) { |
| 155 | if ($line =~ /^\s*vgopts:\s*(.*)$/) { |
| 156 | $vgopts = $1; |
| 157 | } elsif ($line =~ /^\s*prog:\s*(.*)$/) { |
| 158 | $prog = validate_program(".", $1); |
| 159 | } elsif ($line =~ /^\s*args:\s*(.*)$/) { |
| 160 | $args = $1; |
| 161 | } elsif ($line =~ /^\s*vgopts\.hd:\s*(.*)$/) { |
| 162 | $vgopts = $1 if ($exp eq ".hd"); |
| 163 | } elsif ($line =~ /^\s*vgopts\.er:\s*(.*)$/) { |
| 164 | $vgopts = $1 if ($exp eq ""); |
| 165 | } elsif ($line =~ /^\s*stdout_filter:\s*(.*)$/) { |
| 166 | $stdout_filter = validate_program(".", $1); |
| 167 | } elsif ($line =~ /^\s*stderr_filter:\s*(.*)$/) { |
| 168 | $stderr_filter = validate_program(".", $1); |
| 169 | } else { |
| 170 | die "Bad line in $f: $line\n"; |
| 171 | } |
| 172 | } |
| 173 | close(INPUTFILE); |
| 174 | |
| 175 | if (!defined $prog) { |
| 176 | die "no `prog:' line in `$f'\n"; |
| 177 | } |
| 178 | } |
| 179 | |
| 180 | #---------------------------------------------------------------------------- |
| 181 | # Do one test |
| 182 | #---------------------------------------------------------------------------- |
| 183 | # Since most of the program time is spent in system() calls, need this to |
| 184 | # propagate a Ctrl-C enabling us to quit. |
| 185 | sub mysystem($) |
| 186 | { |
| 187 | (system($_[0]) != 2) or exit 1; # 2 is SIGINT |
| 188 | } |
| 189 | |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame^] | 190 | # from a directory name like "/foo/cachesim/tests/" determine the skin name |
| 191 | sub determine_skin() |
| 192 | { |
| 193 | my $dir = `pwd`; |
| 194 | $dir =~ /.*\/([^\/]+)\/tests.*/; # foo/skin_name/tests/foo |
| 195 | return $1; |
| 196 | } |
| 197 | |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 198 | sub do_one_test($$) |
| 199 | { |
| 200 | my ($dir, $vgtest) = @_; |
| 201 | $vgtest =~ /^(.*)\.vgtest/; |
| 202 | my $name = $1; |
| 203 | my $fullname = "$dir/$name"; |
| 204 | |
| 205 | read_vgtest_file($vgtest); |
| 206 | |
| 207 | printf("%-30s valgrind $vgopts $prog $args\n", "$fullname:"); |
| 208 | |
| 209 | # If --eraser, pass the apt. --skin option for the directory (can be |
| 210 | # overridden by an "args:" or "args.er:" line, though) |
| 211 | if ($exp eq ".hd") { |
| 212 | mysystem("$valgrind $vgopts $prog $args > $name.stdout.out 2> $name.stderr.out"); |
| 213 | } else { |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame^] | 214 | my $skin=determine_skin(); |
| 215 | mysystem("$valgrind --skin=$skin $vgopts $prog $args > $name.stdout.out 2> $name.stderr.out"); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 216 | } |
| 217 | |
| 218 | if (defined $stdout_filter) { |
| 219 | mysystem("$stdout_filter < $name.stdout.out > $tmp"); |
| 220 | rename($tmp, "$name.stdout.out"); |
| 221 | } |
| 222 | |
| 223 | mysystem("$stderr_filter < $name.stderr.out > $tmp"); |
| 224 | rename($tmp, "$name.stderr.out"); |
| 225 | |
| 226 | # If stdout expected empty, .exp file might be missing so diff with |
| 227 | # /dev/null |
| 228 | my $stdout_exp = ( -r "$name.stdout.exp" |
| 229 | ? "$name.stdout.exp" |
| 230 | : "/dev/null" ); |
| 231 | |
| 232 | # If 1.0.X/HEAD and ERASER versions have the same expected stderr output, |
| 233 | # foo.stderr.exp.hd might be missing, so use foo.stderr.exp instead if |
| 234 | # --head is true. |
| 235 | my $stderr_exp = "$name.stderr.exp$exp"; |
| 236 | if ($exp eq ".hd" && not -r $stderr_exp) { |
| 237 | $stderr_exp = "$name.stderr.exp"; |
| 238 | } |
| 239 | (-r $stderr_exp) or die "Could not read `$stderr_exp'\n"; |
| 240 | |
| 241 | mysystem("diff -C0 $stdout_exp $name.stdout.out > $name.stdout.diff"); |
| 242 | mysystem("diff -C0 $stderr_exp $name.stderr.out > $name.stderr.diff"); |
| 243 | |
| 244 | for my $ext ("stdout", "stderr") { |
| 245 | if (-s "$name.$ext.diff") { |
| 246 | print "*** $fullname failed ($ext) ***\n"; |
| 247 | push(@failures, sprintf("%-30s $ext", "$fullname")); |
| 248 | } else { |
| 249 | unlink("$name.$ext.out", "$name.$ext.diff"); |
| 250 | } |
| 251 | } |
| 252 | } |
| 253 | |
| 254 | #---------------------------------------------------------------------------- |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame^] | 255 | # Test one directory (and any subdirs) |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 256 | #---------------------------------------------------------------------------- |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame^] | 257 | sub test_one_dir($); # forward declaration |
| 258 | |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 259 | sub test_one_dir($) |
| 260 | { |
| 261 | my ($dir) = @_; |
| 262 | $dir =~ s/\/$//; # trim a trailing '/' |
| 263 | |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame^] | 264 | if ($dir =~ /^(CVS|docs)$/) { return; } # ignore CVS/ and docs/ dirs |
| 265 | |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 266 | print "-- Running tests in $dir ----------------------------------\n"; |
| 267 | chdir($dir) or die "Could not change into $dir\n"; |
| 268 | |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame^] | 269 | # my @vgtests = glob "*\.vgtest"; |
| 270 | my @fs = glob "*"; |
| 271 | |
| 272 | foreach my $f (@fs) { |
| 273 | if (-d $f) { |
| 274 | test_one_dir($f); |
| 275 | } elsif ($f =~ /\.vgtest$/) { |
| 276 | do_one_test($dir, $f); |
| 277 | } |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 278 | } |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame^] | 279 | |
| 280 | print "-- Finished tests in $dir ----------------------------------\n"; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 281 | chdir(".."); |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 282 | } |
| 283 | |
| 284 | #---------------------------------------------------------------------------- |
| 285 | # Summarise results |
| 286 | #---------------------------------------------------------------------------- |
| 287 | sub summarise_results |
| 288 | { |
njn25 | cac76cb | 2002-09-23 11:21:57 +0000 | [diff] [blame^] | 289 | print "\n== Failed tests ===============================\n"; |
njn25 | e49d8e7 | 2002-09-23 09:36:25 +0000 | [diff] [blame] | 290 | if (0 == @failures) { |
| 291 | print " (none)\n"; |
| 292 | } else { |
| 293 | foreach my $failure (@failures) { |
| 294 | print "$failure\n"; |
| 295 | } |
| 296 | } |
| 297 | } |
| 298 | |
| 299 | #---------------------------------------------------------------------------- |
| 300 | # main(), sort of |
| 301 | #---------------------------------------------------------------------------- |
| 302 | |
| 303 | # undefine $VALGRIND_OPTS |
| 304 | if ( exists $ENV{VALGRIND_OPTS} ) { |
| 305 | undef $ENV{VALGRIND_OPTS}; |
| 306 | } |
| 307 | |
| 308 | my @fs = process_command_line(); |
| 309 | foreach my $f (@fs) { |
| 310 | if (-d $f) { |
| 311 | test_one_dir($f); |
| 312 | } else { |
| 313 | # Allow the .vgtest suffix to be given or omitted |
| 314 | if ($f =~ /.vgtest$/ && -r $f) { |
| 315 | # do nothing |
| 316 | } elsif (-r "$f.vgtest") { |
| 317 | $f = "$f.vgtest"; |
| 318 | } else { |
| 319 | die "`$f' neither a directory nor a readable test file/name\n" |
| 320 | } |
| 321 | my $dir = `dirname $f`; chomp $dir; |
| 322 | my $file = `basename $f`; chomp $file; |
| 323 | chdir($dir) or die "Could not change into $dir\n"; |
| 324 | do_one_test($dir, $file); |
| 325 | chdir($tests_dir); |
| 326 | } |
| 327 | } |
| 328 | summarise_results(); |
| 329 | |
| 330 | |