tests/vg_regtest.in

#! /usr/bin/perl -w
##--------------------------------------------------------------------##
##--- Valgrind regression testing script                vg_regtest ---##
##--------------------------------------------------------------------##

#  This file is part of Valgrind, an x86 protected-mode emulator 
#  designed for debugging and profiling binaries on x86-Unixes.
#
#  Copyright (C) 2002 Nicholas Nethercote
#     njn25@cam.ac.uk
#
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License as
#  published by the Free Software Foundation; either version 2 of the
#  License, or (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful, but
#  WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#  General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
#  02111-1307, USA.
#
#  The GNU General Public License is contained in the file COPYING.

#----------------------------------------------------------------------------
# usage: vg_regtest [options] <dirs | files>
#
# Options:
#   --stable:   use stable-branch stderr results (*.stderr.exp.hd)
#   --dev:      use dev-branch stderr results    (*.stderr.exp - default)
#   --all:      run tests in all subdirs
#   --valgrind: valgrind to use.  Default is one built from this source tree.
#
# You can specify individual files to test, or whole directories, or both.
# The stable-branch/dev-branch distinction allows slight differences in stderr
# results.
#
# Each test is defined in a file <test>.vgtest, containing one or more of the
# following lines, in any order:
#   - prog:   <prog to run>                         (compulsory)
#   - args:   <args for prog>                       (default: none)
#   - vgopts: <Valgrind options>                    (default: none)
#   - vgopts.st:  <options, --stable only>          (default: none)
#   - vgopts.dev: <options, --dev only>             (default: none)
#   - stdout_filter: <filter to run stdout through> (default: none)
#   - stderr_filter: <filter to run stderr through> (default: ./filter_stderr)
#
# Note that filters are necessary for stderr results to filter out things that
# always change, eg. process id numbers.
#
# Expected stdout (filtered) is kept in <test>.stdout.exp.  It can be missing
# if it would be empty.
#
# Expected stderr (filtered) is kept in <test>.stderr.exp for --dev, and
# <test>.stderr.exp.hd for --stable (silly ".hd" extension for historical
# reasons).
#
# If results don't match, the output can be found in <test>.std<strm>.out,
# and the diff between expected and actual in <test>.std<strm>.diff.
#
# Notes on adding regression tests for a new skin are in
# coregrind/docs/skins.html.
#----------------------------------------------------------------------------

use strict;

#----------------------------------------------------------------------------
# Global vars
#----------------------------------------------------------------------------
my $usage="vg_regtest [--stable|--dev, --all, --valgrind]\n";

my $tmp="vg_regtest.tmp.$$";

# Test variables
my $vgopts;             # valgrind options
my $prog;               # test prog
my $args;               # test prog args
my $stdout_filter;      # filter program to run stdout results file through
my $stderr_filter;      # filter program to run stderr results file through

my @failures;           # List of failed tests

my $exp = "";           # --dev is default

# Default valgrind to use is this build tree's one
my $prefix="@prefix@";
my $exec_prefix="@exec_prefix@";
my $valgrind = "@bindir@/valgrind";

chomp(my $tests_dir = `pwd`);

# default filter is the one named "filter_stderr" in the test's directory
my $default_stderr_filter = "filter_stderr";


#----------------------------------------------------------------------------
# Process command line, setup
#----------------------------------------------------------------------------

# If $prog is a relative path, it prepends $dir to it.  Useful for two reasons:
#
# 1. Can prepend "." onto programs to avoid trouble with users who don't have
#    "." in their path (by making $dir = ".")
# 2. Can prepend the current dir to make the command absolute to avoid
#    subsequent trouble when we change directories.
#
# Also checks the program exists and is executable.
sub validate_program ($$) 
{
    my ($dir, $prog) = @_;

    # If absolute path, leave it alone.  If relative, make it
    # absolute -- by prepending current dir -- so we can change
    # dirs and still use it.
    $prog = "$dir/$prog" if ($prog !~ /^\//);
    (-f $prog) or die "`$prog' not found or not a file ($dir)\n";
    (-x $prog) or die "`$prog' not found or not executable ($dir)\n";

    return $prog;
}

sub process_command_line() 
{
    my $alldirs = 0;
    my @fs;
    
    for my $arg (@ARGV) {
        if ($arg =~ /^-/) {
            if      ($arg =~ /^--stable$/) {
                $exp = ".hd";
            } elsif ($arg =~ /^--dev$/) {
                $exp = "";
            } elsif ($arg =~ /^--all$/) {
                $alldirs = 1;
            } elsif ($arg =~ /^--valgrind=(.*)$/) {
                $valgrind = $1;
            } else {
                die $usage;
            }
        } else {
            push(@fs, $arg);
        }
    }
    $valgrind = validate_program($tests_dir, $valgrind);

    if ($alldirs) {
        @fs = ();
        foreach my $f (glob "*") {
            push(@fs, $f) if (-d $f);
        }
    }

    (0 != @fs) or die "No test files or directories specified\n";

    return @fs;
}

#----------------------------------------------------------------------------
# Read a .vgtest file
#----------------------------------------------------------------------------
sub read_vgtest_file($)
{
    my ($f) = @_;

    # Defaults.
    ($vgopts, $prog, $args, $stdout_filter, $stderr_filter) = 
        ("", undef, "", undef, undef);

    # Every test directory must have a "filter_stderr"
    $stderr_filter = validate_program(".", $default_stderr_filter);

    open(INPUTFILE, "< $f") || die "File $f not openable\n";

    while (my $line = <INPUTFILE>) {
        if      ($line =~ /^\s*vgopts:\s*(.*)$/) {
            $vgopts = $1;
        } elsif ($line =~ /^\s*prog:\s*(.*)$/) {
            $prog = validate_program(".", $1);
        } elsif ($line =~ /^\s*args:\s*(.*)$/) {
            $args = $1;
        } elsif ($line =~ /^\s*vgopts\.st:\s*(.*)$/) {
            $vgopts = $1 if ($exp eq ".hd");
        } elsif ($line =~ /^\s*vgopts\.dev:\s*(.*)$/) {
            $vgopts = $1 if ($exp eq "");
        } elsif ($line =~ /^\s*stdout_filter:\s*(.*)$/) {
            $stdout_filter = validate_program(".", $1);
        } elsif ($line =~ /^\s*stderr_filter:\s*(.*)$/) {
            $stderr_filter = validate_program(".", $1);
        } else {
            die "Bad line in $f: $line\n";
        }
    }
    close(INPUTFILE);

    if (!defined $prog) {
        die "no `prog:' line in `$f'\n";
    }
}

#----------------------------------------------------------------------------
# Do one test
#----------------------------------------------------------------------------
# Since most of the program time is spent in system() calls, need this to
# propagate a Ctrl-C enabling us to quit.
sub mysystem($) 
{
    (system($_[0]) != 2) or exit 1;      # 2 is SIGINT
}

# from a directory name like "/foo/cachesim/tests/" determine the skin name
sub determine_skin()
{
    my $dir = `pwd`;
    $dir =~ /.*\/([^\/]+)\/tests.*/;   # foo/skin_name/tests/foo
    return $1;
}

sub do_one_test($$) 
{
    my ($dir, $vgtest) = @_;
    $vgtest =~ /^(.*)\.vgtest/;
    my $name = $1;
    my $fullname = "$dir/$name"; 

    read_vgtest_file($vgtest);

    printf("%-30s valgrind $vgopts $prog $args\n", "$fullname:");

    # If --dev, pass the appropriate --skin option for the directory (can be
    # overridden by an "args:" or "args.dev:" line, though)
    if ($exp eq ".hd") {
        mysystem("$valgrind $vgopts $prog $args > $name.stdout.out 2> $name.stderr.out");
    } else {
        my $skin=determine_skin();
        mysystem("$valgrind --skin=$skin $vgopts $prog $args > $name.stdout.out 2> $name.stderr.out");
    }

    if (defined $stdout_filter) {
        mysystem("$stdout_filter < $name.stdout.out > $tmp");
        rename($tmp, "$name.stdout.out");
    }

    mysystem("$stderr_filter < $name.stderr.out > $tmp");
    rename($tmp, "$name.stderr.out");

    # If stdout expected empty, .exp file might be missing so diff with 
    # /dev/null
    my $stdout_exp = ( -r "$name.stdout.exp" 
                     ? "$name.stdout.exp" 
                     : "/dev/null" );

    # If stable-branch and dev-branch have the same expected stderr output,
    # foo.stderr.exp.hd might be missing, so use foo.stderr.exp instead if
    # --stable is true.
    my $stderr_exp = "$name.stderr.exp$exp";
    if ($exp eq ".hd" && not -r $stderr_exp) {
       $stderr_exp = "$name.stderr.exp";
    }
    (-r $stderr_exp) or die "Could not read `$stderr_exp'\n";

    mysystem("diff -C0 $stdout_exp $name.stdout.out > $name.stdout.diff");
    mysystem("diff -C0 $stderr_exp $name.stderr.out > $name.stderr.diff");

    for my $ext ("stdout", "stderr") {
        if (-s "$name.$ext.diff") {
            print "*** $fullname failed ($ext) ***\n";
            push(@failures, sprintf("%-30s $ext", "$fullname"));
        } else {
            unlink("$name.$ext.out", "$name.$ext.diff");
        }
    }
}

#----------------------------------------------------------------------------
# Test one directory (and any subdirs)
#----------------------------------------------------------------------------
sub test_one_dir($);    # forward declaration

sub test_one_dir($) 
{
    my ($dir) = @_;
    $dir =~ s/\/$//;    # trim a trailing '/'

    if ($dir =~ /^(CVS|docs)$/) { return; }    # ignore CVS/ and docs/ dirs

    print "-- Running tests in $dir ----------------------------------\n";
    chdir($dir) or die "Could not change into $dir\n";

#    my @vgtests = glob "*\.vgtest";
    my @fs = glob "*";

    foreach my $f (@fs) {
        if (-d $f) {
            test_one_dir($f);
        } elsif ($f =~ /\.vgtest$/) {
            do_one_test($dir, $f);
        }
    }
    
    print "-- Finished tests in $dir ----------------------------------\n";
    chdir("..");
}

#----------------------------------------------------------------------------
# Summarise results
#----------------------------------------------------------------------------
sub summarise_results 
{
    print "\n== Failed tests ===============================\n";
    if (0 == @failures) {
        print "   (none)\n";
    } else {
        foreach my $failure (@failures) {
            print "$failure\n";
        }
    }
}

#----------------------------------------------------------------------------
# main(), sort of
#----------------------------------------------------------------------------

# undefine $VALGRIND_OPTS
if ( exists $ENV{VALGRIND_OPTS} ) {
  undef $ENV{VALGRIND_OPTS};
}

my @fs = process_command_line();
foreach my $f (@fs) {
    if (-d $f) {
        test_one_dir($f);
    } else { 
        # Allow the .vgtest suffix to be given or omitted
        if ($f =~ /.vgtest$/ && -r $f) {
            # do nothing
        } elsif (-r "$f.vgtest") {
            $f = "$f.vgtest";
        } else {
            die "`$f' neither a directory nor a readable test file/name\n"
        }
        my $dir  = `dirname  $f`;   chomp $dir;
        my $file = `basename $f`;   chomp $file;
        chdir($dir) or die "Could not change into $dir\n";
        do_one_test($dir, $file);
        chdir($tests_dir);
    }
}
summarise_results();

##--------------------------------------------------------------------##
##--- end                                               vg_regtest ---##
##--------------------------------------------------------------------##