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