Sweden-Number/tools/winapi_check/nativeapi.pm

223 lines
5.0 KiB
Perl
Raw Normal View History

#
# Copyright 1999, 2000, 2001 Patrik Stridvall
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library 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
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
package nativeapi;
use strict;
2001-07-14 02:48:41 +02:00
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw($nativeapi);
use vars qw($nativeapi);
use config qw(file_type $current_dir $wine_dir $winapi_check_dir);
use options qw($options);
use output qw($output);
$nativeapi = 'nativeapi'->new;
sub new($) {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
my $functions = \%{$self->{FUNCTIONS}};
my $conditionals = \%{$self->{CONDITIONALS}};
my $conditional_headers = \%{$self->{CONDITIONAL_HEADERS}};
my $conditional_functions = \%{$self->{CONDITIONAL_FUNCTIONS}};
my $api_file = "$winapi_check_dir/nativeapi.dat";
2002-03-11 02:17:04 +01:00
my $configure_ac_file = "$wine_dir/configure.ac";
my $config_h_in_file = "$wine_dir/include/config.h.in";
1999-11-08 00:35:03 +01:00
$api_file =~ s/^\.\///;
2002-03-11 02:17:04 +01:00
$configure_ac_file =~ s/^\.\///;
1999-11-08 00:35:03 +01:00
$config_h_in_file =~ s/^\.\///;
2003-08-08 23:04:17 +02:00
$$conditional_headers{"config.h"}++;
$output->progress("$api_file");
open(IN, "< $api_file");
local $/ = "\n";
while(<IN>) {
2001-07-14 02:48:41 +02:00
s/^\s*(.*?)\s*$/$1/; # remove whitespace at begin and end of line
s/^(.*?)\s*#.*$/$1/; # remove comments
2002-06-01 04:55:48 +02:00
/^$/ && next; # skip empty lines
2001-07-14 02:48:41 +02:00
$$functions{$_}++;
}
close(IN);
2002-03-11 02:17:04 +01:00
$output->progress("$configure_ac_file");
my $again = 0;
2002-06-01 04:55:48 +02:00
open(IN, "< $configure_ac_file");
local $/ = "\n";
while($again || (defined($_ = <IN>))) {
$again = 0;
chomp;
2000-09-04 22:20:47 +02:00
if(/^(.*?)\\$/) {
my $current = $1;
my $next = <IN>;
if(defined($next)) {
# remove trailing whitespace
$current =~ s/\s+$//;
# remove leading whitespace
$next =~ s/^\s+//;
$_ = $current . " " . $next;
$again = 1;
next;
}
}
2000-09-04 22:20:47 +02:00
# remove leading and trailing whitespace
s/^\s*(.*?)\s*$/$1/;
2000-09-04 22:20:47 +02:00
# skip emty lines
if(/^$/) { next; }
# skip comments
if(/^dnl/) { next; }
2003-08-08 23:04:17 +02:00
if(/AC_CHECK_HEADERS\(\s*([^,\)]*)(?:,|\))?/) {
my $headers = $1;
$headers =~ s/^\s*\[\s*(.*?)\s*\]\s*$/$1/;
foreach my $name (split(/\s+/, $headers)) {
$$conditional_headers{$name}++;
}
2003-08-08 23:04:17 +02:00
} elsif(/AC_CHECK_FUNCS\(\s*([^,\)]*)(?:,|\))?/) {
my $funcs = $1;
$funcs =~ s/^\s*\[\s*(.*?)\s*\]\s*$/$1/;
foreach my $name (split(/\s+/, $funcs)) {
$$conditional_functions{$name}++;
}
2003-08-08 23:04:17 +02:00
} elsif(/AC_FUNC_ALLOCA/) {
$$conditional_headers{"alloca.h"}++;
2003-08-08 23:04:17 +02:00
} elsif (/AC_DEFINE\(\s*HAVE_(.*?)_H/) {
my $name = lc($1);
$name =~ s/_/\//;
$name .= ".h";
next if $name =~ m%correct/%;
$$conditional_headers{$name}++;
}
}
close(IN);
$output->progress("$config_h_in_file");
open(IN, "< $config_h_in_file");
local $/ = "\n";
while(<IN>) {
2000-09-04 22:20:47 +02:00
# remove leading and trailing whitespace
s/^\s*(.*?)\s*$/$1/;
# skip emty lines
if(/^$/) { next; }
if(/^\#undef\s+(\S+)$/) {
$$conditionals{$1}++;
}
}
close(IN);
2001-07-14 02:48:41 +02:00
$nativeapi = $self;
return $self;
}
sub is_function($$) {
my $self = shift;
my $functions = \%{$self->{FUNCTIONS}};
my $name = shift;
return ($$functions{$name} || 0);
}
sub is_conditional($$) {
my $self = shift;
my $conditionals = \%{$self->{CONDITIONALS}};
my $name = shift;
return ($$conditionals{$name} || 0);
}
sub found_conditional($$) {
2000-09-04 22:20:47 +02:00
my $self = shift;
my $conditional_found = \%{$self->{CONDITIONAL_FOUND}};
my $name = shift;
$$conditional_found{$name}++;
}
sub is_conditional_header($$) {
my $self = shift;
my $conditional_headers = \%{$self->{CONDITIONAL_HEADERS}};
my $name = shift;
return ($$conditional_headers{$name} || 0);
}
sub is_conditional_function($$) {
my $self = shift;
my $conditional_functions = \%{$self->{CONDITIONAL_FUNCTIONS}};
my $name = shift;
return ($$conditional_functions{$name} || 0);
}
sub global_report($) {
2000-09-04 22:20:47 +02:00
my $self = shift;
my $output = \${$self->{OUTPUT}};
my $conditional_found = \%{$self->{CONDITIONAL_FOUND}};
my $conditionals = \%{$self->{CONDITIONALS}};
my @messages;
foreach my $name (sort(keys(%$conditionals))) {
if($name =~ /^(?:const|inline|size_t)$/) { next; }
2000-09-04 22:20:47 +02:00
if(0 && !$$conditional_found{$name}) {
push @messages, "config.h.in: conditional $name not used\n";
}
}
foreach my $message (sort(@messages)) {
$output->write($message);
2000-09-04 22:20:47 +02:00
}
}
1;