#!/usr/bin/perl -w
use strict;

my $name0=$0;
$name0 =~ s+^.*/++;

my $opt_verbose;

# For each entry point we store:
# * ordinal
#   An empty string if it is not significant
#
# * name
#   An empty string if there is no name
#
# * call convention
#   stub, stdcall, cdecl, ...
#
# * properties
#   Space separated list of properties such as -noname

sub read_dumpbin($)
{
    my $filename=$_[0];

    if ($opt_verbose)
    {
        print "Reading dumpbin file '$filename'\n";
    }
    my $header=<FILE>;
    if ($header !~ /Binary File Dumper/)
    {
        # This is not a dumpbin file!
        if ($opt_verbose)
        {
            print " -> not a dumpbin file\n";
        }
        return;
    }

    # Find the exports section
    while (<FILE>)
    {
        last if (/^\s+Section contains the following exports/);
    }

    # Read it
    my $hash={};
    while (<FILE>)
    {
        chomp;
        if (/^\s+Summary\s+\r?$/)
        {
            # That's the header for the next section
            last;
        }
        if (/^\s+([0-9]+)\s+[0-9A-F]+\s[0-9A-F ]{8}\s(\S+)/)
        {
            my $ordinal=$1;
            my $name=$2;
            my $entry=[$ordinal,$name,"",""];
            $hash->{$name}=$entry;
            $hash->{$ordinal}=$entry;
        }
        elsif (/^\s+([0-9]+)\s+[0-9A-F ]{8}\s\[NONAME\]/)
        {
            my $ordinal=$1;
            my $entry=[$ordinal,"","","-noname"];
            $hash->{$ordinal}=$entry;
        }
    }

    return $hash;
}

sub read_winedump($)
{
    my $filename=$_[0];

    if ($opt_verbose)
    {
        print "Reading dumpbin file '$filename'\n";
    }
    my $header=<FILE>;
    if ($header !~ /Binary File Dumper/)
    {
        # This is not a dumpbin file!
        if ($opt_verbose)
        {
            print " -> not a dumpbin file\n";
        }
        return;
    }

    # Find the exports section
    while (<FILE>)
    {
        last if (/^Exports table/);
    }

    # Read it
    my $hash={};
    while (<FILE>)
    {
        next if (/^Addresses of/);
        last if (/^\w/);
        chomp;

        if (/^\s+[0-9a-fA-F]{8}\s+([0-9]+)\s+(\S+)/)
        {
            my $ordinal=$1;
            my $name=$2;
            my $entry=[$ordinal,$name,"",""];
            $hash->{$name}=$entry;
            $hash->{$ordinal}=$entry;
        }
        if (/^\s+[0-9a-fA-F]{8}\s+([0-9]+)\s+<by ordinal>/)
        {
            my $ordinal=$1;
            my $entry=[$ordinal,"","","-noname"];
            $hash->{$ordinal}=$entry;
        }
    }

    return $hash;
}

sub read_wine_spec($)
{
    my $filename=$_[0];

    if ($opt_verbose)
    {
        print "Reading spec file '$filename'\n";
    }

    # Read the exports section
    my $hash={};
    while (<FILE>)
    {
        chomp;
        if (/^\s*type\s+win16/)
        {
            # Wrong type of dll
            print "16 bit dlls are not supported\n";
            return;
        }
        elsif (/^\s*([0-9]+|\@)\s+(\w+)\s+(-\w+\s+)*([^- (]+|\@)/)
        {
            my $ordinal=$1;
            my $call=$2;
            my $properties=$3;
            my $name=$4;
            $ordinal="" if ($ordinal eq "@");
            $name="" if ($name eq "@");
            $properties="" if (!defined $properties);
            my $entry=[$ordinal,$name,$call,$properties];

            $hash->{$ordinal}=$entry if ($ordinal ne "");
            $hash->{$name}=$entry if ($name ne "");
        }
    }

    return $hash;
}

sub read_file($)
{
    my $filename=$_[0];
    my $hash;

    if (!open(FILE,"<$filename"))
    {
        print STDERR "$name0:error: cannot open '$filename' for reading: $!\n";
        exit(1);
    }

    $hash=read_dumpbin($filename) if ($filename !~ /.spec$/);
    $hash=read_wine_spec($filename) if (!$hash);
    if (!$hash)
    {
        print STDERR "$name0:error: unknown file format (win16?)\n";
    }
    close(FILE);
    return $hash;
}

sub api($)
{
    my $name=$_[0];
    $name.=" " x (30-length($name));
    return $name;
}

sub dump_list($$)
{
    my $header=$_[0];
    my $list=$_[1];
    my $count=@$list;
    if ($count)
    {
        print "These $count APIs $header:\n";
        map { print "  $_\n" } @$list;
    }
}


#####
#
# Main
#
#####

my $usage;
my $platform_dir;
my @platforms;
my $specfile;

# Parse the options
while (@ARGV)
{
    my $arg=shift @ARGV;
    if ($arg eq "--platform-dir")
    {
        $platform_dir=shift @ARGV;
    }
    elsif ($arg eq "--platforms")
    {
        @platforms=split /:+/, shift @ARGV;
    }
    elsif ($arg eq "--spec")
    {
        $specfile=shift @ARGV;
    }
    elsif ($arg eq "--verbose")
    {
        $opt_verbose=1;
    }
    elsif ($arg eq "-h" or $arg eq "-?")
    {
        $usage=0;
    }
    else
    {
        print STDERR "$name0:error: unknown option '$arg'\n";
        $usage=2;
    }
}

# Parameter post-processing
@platforms=("api95","api98","apime","apint4","api2000","apixp","api2003es") if (@platforms == 0);
if (@platforms == 1)
{
    print STDERR "$name0:error: more than one reference platform is needed\n";
    $usage=1;
}
$platform_dir="." if (!defined $platform_dir);
if (!defined $specfile)
{
    print STDERR "$name0:error: you must specify a spec file\n";
    $usage=2;
}
elsif (!-f $specfile)
{
    print STDERR "$name0:error: '$specfile' not found\n";
    $usage=2;
}

# Print usage
if (defined $usage)
{
    print STDERR "Usage: check_spec --spec specfile [--platform-dir platform_dir] [--platforms platforms]\n";
    exit $usage;
}


# Read the platform files
my $dll=$specfile;
$dll =~ s%^.*/%%;
$dll =~ s/\.spec$//;
my $windows;
foreach my $platform (@platforms)
{
    my $filename="$platform_dir/$platform/$dll-api.txt";
    if (-f $filename)
    {
        my $hash=read_file($filename);
        $windows->{$platform}=$hash if ($hash);
    }
}
my $platform_count=keys %$windows;
print "$dll found on $platform_count platforms\n";
if ($platform_count <= 1)
{
    print STDERR "$name0:error: '$dll' is not present on enough platforms\n";
    exit 1;
}


# Read Wine's spec file
my $spec=read_file($specfile);
if (!defined $spec)
{
    print STDERR "$name0:error: unable to read Wine's spec file\n";
    exit 1;
}


# Check for APIs that should not have an ordinal
my @wrong_ordinal;
my @no_ordinal;
foreach my $name (grep !/^[0-9]/, keys %$spec)
{
    my $wine_entry=$spec->{$name};
    next if (@$wine_entry[0] eq "");

    my $ordinals;
    foreach my $platform (@platforms)
    {
        my $entry=$windows->{$platform}->{$name};
        if (defined $entry)
        {
            if (defined $ordinals->{@$entry[0]})
            {
                $ordinals->{@$entry[0]}.=" $platform";
            }
            else
            {
                $ordinals->{@$entry[0]}=$platform;
            }
        }
    }
    my $count=keys %$ordinals;
    if ($count > 1)
    {
        my $correct=$ordinals->{@$wine_entry[0]} || "";
        my @p=split / /, $correct;
        $correct=@p;
        push @no_ordinal, api($name) ." (correct $correct times, found $count values)";
    }
    elsif ($count == 1 and !defined $ordinals->{@$wine_entry[0]})
    {
        my $correct=(keys %$ordinals)[0];
        my $p=(values %$ordinals)[0];
        push @wrong_ordinal, api($name) ." (is $correct on $p)";
    }
}
dump_list("should not have an ordinal", \@no_ordinal);
dump_list("have the wrong ordinal", \@wrong_ordinal);


# Check for -noname APIs
my @nonames;
my @not_nonames;
foreach my $name (grep !/^[0-9]/, keys %$spec)
{
    my $wine_entry=$spec->{$name};
    next if (@$wine_entry[0] eq "");

    my @missing;
    my @other;
    foreach my $platform (@platforms)
    {
        my $entry=$windows->{$platform}->{$name};
        if (!defined $entry)
        {
            # Maybe this is a new API which did not exist on this possibly
            # older platform. So check if its ordinal already existed and
            # has no name.
            $entry=$windows->{$platform}->{@$wine_entry[0]};
            if (defined $entry)
            {
                if (@$entry[1] eq "")
                {
                    push @missing, $platform;
                }
                else
                {
                    # This ordinal points to another API so it cannot have
                    # the -noname property.
                    push @other, $platform;
                }
            }
        }
    }
    @missing=() if (@other);
    if (@missing != 0 and @$wine_entry[3] !~ /-noname/)
    {
        if (@missing == $platform_count)
        {
            push @nonames, api($name) ." (@$wine_entry[0] has no name on all)";
        }
        else
        {
            push @nonames, api($name) ." (@$wine_entry[0] has no name on @missing)";
        }
    }
    elsif (@missing == 0 and @$wine_entry[3] =~ /-noname/)
    {
        if (@other)
        {
            push @not_nonames, api($name) . " (@$wine_entry[0] has other names on @other)";
        }
        else
        {
            push @not_nonames, "$name";
        }
    }
}
dump_list("should have the -noname property", \@nonames);
dump_list("should not have the -noname property", \@not_nonames);


# Check for missing APIs
# Only APIs present on all platforms are considered as 'missing'.
# That's per Wine's policy to not add APIs that are only present on newer
# platforms unless we have a good reason to.
my @missing;
foreach my $name (grep !/^[0-9]/, keys %{$windows->{$platforms[0]}})
{
    my $wine_entry=$spec->{$name};
    next if (defined $wine_entry);

    my $exists=1;
    foreach my $platform (@platforms)
    {
        my $entry=$windows->{$platform}->{$name};
        if (!defined $entry)
        {
            $exists=0;
            last;
        }
    }
    push @missing,"$name" if ($exists);
}
dump_list("are missing", \@missing);