#!/usr/bin/env perl

#-------------------------------------------------------------------
# Check header files and #include directives
#
# (1) include/*.h must not include pub_core_...h
# (2) coregrind/pub_core_xyzzy.h may include pub_tool_xyzzy.h
#     other coregrind headers may not include pub_tool_xyzzy.h
# (3) coregrind/ *.c must not include pub_tool_xyzzy.h
# (4) tool *.[ch] files must not include pub_core_...h
# (5) include pub_core/tool_clreq.h instead of valgrind.h except in tools'
#     export headers
# (6) coregrind/ *.[ch] must not use tl_assert
# (7) include/*.h and tool *.[ch] must not use vg_assert
# (8) coregrind/ *.[ch] must not use VG_(tool_panic)
# (9) include/*.h and tool *.[ch] must not use VG_(core_panic)
# (10) *.S must unconditionally instantiate MARK_STACK_NO_EXEC
#
# There can be false positives as we don't really parse the source files.
# Instead we only match regular expressions.
#-------------------------------------------------------------------

use strict;
use warnings;
use File::Basename;
use Getopt::Long;

my $this_script = basename($0);

# The list of top-level directories is divided into three sets:
#
# (1) coregrind directories
# (2) tool directories
# (3) directories to ignore
#
# If a directory is found that does not belong to any of those sets, the
# script will terminate unsuccessfully.

my %coregrind_dirs = (
    "include" => 1,
    "coregrind" => 1,
    );

my %tool_dirs = (
    "memcheck" => 1,
    "cachegrind" => 1,
    "callgrind" => 1,
    "helgrind", => 1,
    "drd" => 1,
    "massif" => 1,
    "dhat" => 1,
    "lackey" => 1,
    "none" => 1,
    "exp-bbv" => 1,
    "shared" => 1,
    );

my %dirs_to_ignore = (
    ".deps" => 1,
    ".git" => 1,
    ".in_place" => 1,
    "Inst" => 1,            # the nightly scripts creates this
    "VEX" => 1,
    "docs" => 1,
    "auxprogs" => 1,
    "autom4te.cache" => 1,
    "nightly" => 1,
    "perf" => 1,
    "tests" => 1,
    "gdbserver_tests" => 1,
    "mpi" => 1,
    "solaris" => 1
    );

my %tool_export_header = (
    "dhat/dhat.h" => 1,
    "drd/drd.h" => 1,
    "helgrind/helgrind.h" => 1,
    "memcheck/memcheck.h" => 1,
    "callgrind/callgrind.h" => 1,
    "cachegrind/cachegrind.h" => 1
    );

my $usage=<<EOF;
USAGE

  $this_script

    [--debug]          Debugging output

    dir ...            Directories to process
EOF

my $debug = 0;
my $num_errors = 0;

&main;

sub main {
    GetOptions( "debug"  => \$debug ) || die $usage;

    my $argc = $#ARGV + 1;

    if ($argc < 1) {
        die $usage;
    }

    foreach my $dir (@ARGV) {
        process_dir(undef, $dir, 0);
    }

    my $rc = ($num_errors == 0) ? 0 : 1;
    exit $rc;
}

sub process_dir {
    my ($path, $dir, $depth) = @_;
    my $hdir;

    if ($depth == 0) {
# The root directory is always processed
    } elsif ($depth == 1) {
# Toplevel directories
        return if ($dirs_to_ignore{$dir});

        if (! $tool_dirs{$dir} && ! $coregrind_dirs{$dir}) {
            die "Unknown directory '$dir'. Please update $this_script\n";
        }
    } else {
# Subdirectories
        return if ($dirs_to_ignore{$dir});
    }

    print "DIR = $dir   DEPTH = $depth\n" if ($debug);

    chdir($dir) || die "Cannot chdir '$dir'\n";

    opendir($hdir, ".") || die "cannot open directory '.'";

    while (my $file = readdir($hdir)) {
        next if ($file eq ".");
        next if ($file eq "..");

# Subdirectories
        if (-d $file) {
            my $full_path = defined $path ? "$path/$file" : $file;
            process_dir($full_path, $file, $depth + 1);
            next;
        }

# Regular files; only interested in *.c, *.S and *.h
        next if (! ($file =~ /\.[cSh]$/));
        my $path_name = defined $path ? "$path/$file" : $file;
        process_file($path_name);
    }
    close($hdir);
    chdir("..") || die "Cannot chdir '..'\n";
}

#---------------------------------------------------------------------
# Return 1, if file is located in <valgrind>/include
#---------------------------------------------------------------------
sub is_coregrind_export_header {
    my ($path_name) = @_;

    return ($path_name =~ /^include\//) ? 1 : 0;
}

#---------------------------------------------------------------------
# Return 1, if file is located underneath <valgrind>/coregrind
#---------------------------------------------------------------------
sub is_coregrind_file {
    my ($path_name) = @_;

    return ($path_name =~ /^coregrind\//) ? 1 : 0;
}

#---------------------------------------------------------------------
# Return 1, if file is located underneath <valgrind>/<tool>
#---------------------------------------------------------------------
sub is_tool_file {
    my ($path_name) = @_;

    for my $tool (keys %tool_dirs) {
        return 1 if ($path_name =~ /^$tool\//);
    }
    return 0
}

#---------------------------------------------------------------------
# Return array of files #include'd by file.
#---------------------------------------------------------------------
sub get_included_files {
    my ($path_name) = @_;
    my @includes = ();
    my $file = basename($path_name);

    open(FILE, "<$file") || die "Cannot open file '$file'";

    while (my $line = <FILE>) {
        if ($line =~ /^\s*#\s*include "([^"]*)"/) {
            push @includes, $1;
        }
        if ($line =~ /^\s*#\s*include <([^>]*)>/) {
            push @includes, $1;
        }
    }
    close FILE;
    return @includes;
}

#---------------------------------------------------------------------
# Check a file from <valgrind>/include
#---------------------------------------------------------------------
sub check_coregrind_export_header {
    my ($path_name) = @_;
    my $file = basename($path_name);

    foreach my $inc (get_included_files($path_name)) {
        $inc = basename($inc);
# Must not include pub_core_....
        if ($inc =~ /pub_core_/) {
            error("File $path_name must not include $inc\n");
        }
# Only pub_tool_clreq.h may include valgrind.h
        if (($inc eq "valgrind.h") && ($path_name ne "include/pub_tool_clreq.h")) {
            error("File $path_name should include pub_tool_clreq.h instead of $inc\n");
        }
    }
# Must not use vg_assert
    my $assert = `grep vg_assert $file`;
    if ($assert ne "") {
        error("File $path_name must not use vg_assert\n");
    }
# Must not use VG_(core_panic)
    my $panic = `grep 'VG_(core_panic)' $file`;
    if ($panic ne "") {
        error("File $path_name must not use VG_(core_panic)\n");
    }
}

#---------------------------------------------------------------------
# Check a file from <valgrind>/coregrind
#---------------------------------------------------------------------
sub check_coregrind_file {
    my ($path_name) = @_;
    my $file = basename($path_name);

    foreach my $inc (get_included_files($path_name)) {
        print "\tINCLUDE $inc\n" if ($debug);
# Only pub_tool_xyzzy.h may include pub_core_xyzzy.h
        if ($inc =~ /pub_tool_/) {
            my $buddy = $inc;
            $buddy =~ s/pub_tool/pub_core/;
            if ($file ne $buddy) {
                error("File $path_name must not include $inc\n");
            }
        }
# Must not include valgrind.h
        if ($inc eq "valgrind.h") {
            error("File $path_name should include pub_core_clreq.h instead of $inc\n");
        }
    }
# Must not use tl_assert
    my $assert = `grep tl_assert $file`;
    if ($assert ne "") {
        error("File $path_name must not use tl_assert\n");
    }
# Must not use VG_(tool_panic)
    my $panic = `grep 'VG_(tool_panic)' $file`;
    if ($panic ne "") {
        chomp($panic);
# Do not complain about the definition of VG_(tool_panic)
        if (($path_name eq "coregrind/m_libcassert.c") &&
            ($panic eq "void VG_(tool_panic) ( const HChar* str )")) {
# OK
        } else {
            error("File $path_name must not use VG_(tool_panic)\n");
        }
    }
}

#---------------------------------------------------------------------
# Check a file from <valgrind>/<tool>
#---------------------------------------------------------------------
sub check_tool_file {
    my ($path_name) = @_;
    my $file = basename($path_name);

    foreach my $inc (get_included_files($path_name)) {
        print "\tINCLUDE $inc\n" if ($debug);
# Must not include pub_core_...
        if ($inc =~ /pub_core_/) {
            error("File $path_name must not include $inc\n");
        }
# Must not include valgrind.h unless this is an export header
        if ($inc eq "valgrind.h" && ! $tool_export_header{$path_name}) {
            error("File $path_name should include pub_tool_clreq.h instead of $inc\n");
        }
    }
# Must not use vg_assert
    my $assert = `grep vg_assert $file`;
    if ($assert ne "") {
        error("File $path_name must not use vg_assert\n");
    }
# Must not use VG_(core_panic)
    my $panic = `grep 'VG_(core_panic)' $file`;
    if ($panic ne "") {
        error("File $path_name must not use VG_(core_panic)\n");
    }
}

#---------------------------------------------------------------------
# Check an assembler file
#---------------------------------------------------------------------
sub check_assembler_file {
    my ($path_name) = @_;
    my $file = basename($path_name);
    my $found = 0;

    open(FILE, "<$file") || die "Cannot open file '$file'";

    while (my $line = <FILE>) {
        if ($line =~ /^\s*MARK_STACK_NO_EXEC/) {
            $found = 1;
            last;
        }
    }
    if ($found == 0) {
        error("File $path_name does not instantiate MARK_STACK_NO_EXEC\n");
    } else {
        while (my $line = <FILE>) {
            if ($line =~ /^\s*#\s*endif/) {
                error("File $path_name instantiates MARK_STACK_NO_EXEC"
                      . " under a condition\n");
                last;
            }
        }
    }
    close FILE;
}

sub process_file {
    my ($path_name) = @_;

    print "FILE = $path_name\n" if ($debug);

    if (is_coregrind_export_header($path_name)) {
        check_coregrind_export_header($path_name);
    } elsif (is_coregrind_file($path_name)) {
        check_coregrind_file($path_name);
    } elsif (is_tool_file($path_name)) {
        check_tool_file($path_name);
    }

    if ($path_name =~ /\.S$/) {
        check_assembler_file($path_name);
    }
}

sub error {
    my ($message) = @_;
    print STDERR "*** $message";
    ++$num_errors;
}
