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