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# --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 115use warnings; 116use strict; 117 118#---------------------------------------------------------------------------- 119# Global vars 120#---------------------------------------------------------------------------- 121my $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 127my $tmp="vg_regtest.tmp.$$"; 128 129# Test variables 130my $vgopts; # valgrind options 131my $prog; # test prog 132my $args; # test prog args 133my $stdout_filter; # filter program to run stdout results file through 134my $stderr_filter; # filter program to run stderr results file through 135my $stdout_filter_args; # arguments passed to stdout_filter 136my $stderr_filter_args; # arguments passed to stderr_filter 137my $progB; # Same but for progB 138my $argsB; # 139my $stdoutB_filter; # 140my $stderrB_filter; # 141my $stdoutB_filter_args;# arguments passed to stdout_filterB 142my $stderrB_filter_args;# arguments passed to stderr_filterB 143my $stdinB; # Input file for progB 144my $prereq; # prerequisite test to satisfy before running test 145my $post; # check command after running test 146my $cleanup; # cleanup command to run 147 148my @failures; # List of failed tests 149 150my $num_tests_done = 0; 151my %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 156my $valgrind = "./coregrind/valgrind"; 157 158chomp(my $tests_dir = `pwd`); 159 160my $valgrind_lib = "$tests_dir/.in_place"; 161my $keepunfiltered = 0; 162 163# default filter is the one named "filter_stderr" in the test's directory 164my $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. 179sub 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 197sub 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#---------------------------------------------------------------------------- 236sub 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. 311sub 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 320sub 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 330sub 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. 339sub 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 375sub 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#---------------------------------------------------------------------------- 514sub test_one_dir($$); # forward declaration 515 516sub 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#---------------------------------------------------------------------------- 566sub plural($) 567{ 568 return ( $_[0] == 1 ? "" : "s" ); 569} 570 571sub 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#---------------------------------------------------------------------------- 594sub 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 605if ($ENV{"EXTRA_REGTEST_OPTS"}) { 606 print "\n"; 607 warn_about_EXTRA_REGTEST_OPTS(); 608} 609 610my @fs = process_command_line(); 611foreach 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} 630summarise_results(); 631 632if ($ENV{"EXTRA_REGTEST_OPTS"}) { 633 warn_about_EXTRA_REGTEST_OPTS(); 634} 635 636if (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