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