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