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