tools/winapi_check/nativeapi.pm

   1 #
   2 # Copyright 1999, 2000, 2001 Patrik Stridvall
   3 #
   4 # This library is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU Lesser General Public
   6 # License as published by the Free Software Foundation; either
   7 # version 2.1 of the License, or (at your option) any later version.
   8 #
   9 # This library is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # Lesser General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU Lesser General Public
  15 # License along with this library; if not, write to the Free Software
  16 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  17 #
  18
  19 package nativeapi;
  20
  21 use strict;
  22
  23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  24 require Exporter;
  25
  26 @ISA = qw(Exporter);
  27 @EXPORT = qw();
  28 @EXPORT_OK = qw($nativeapi);
  29
  30 use vars qw($nativeapi);
  31
  32 use config qw(&file_type $current_dir $wine_dir $winapi_check_dir);
  33 use options qw($options);
  34 use output qw($output);
  35
  36 $nativeapi = 'nativeapi'->new;
  37
  38 sub new {
  39     my $proto = shift;
  40     my $class = ref($proto) || $proto;
  41     my $self  = {};
  42     bless ($self, $class);
  43
  44     my $functions = \%{$self->{FUNCTIONS}};
  45     my $conditionals = \%{$self->{CONDITIONALS}};
  46     my $conditional_headers = \%{$self->{CONDITIONAL_HEADERS}};
  47     my $conditional_functions = \%{$self->{CONDITIONAL_FUNCTIONS}};
  48
  49     my $api_file = "$winapi_check_dir/nativeapi.dat";
  50     my $configure_ac_file = "$wine_dir/configure.ac";
  51     my $config_h_in_file = "$wine_dir/include/config.h.in";
  52
  53     $api_file =~ s/^\.\///;
  54     $configure_ac_file =~ s/^\.\///;
  55     $config_h_in_file =~ s/^\.\///;
  56
  57     $output->progress("$api_file");
  58
  59     open(IN, "< $api_file");
  60     local $/ = "\n";
  61     while(<IN>) {
  62         s/^\s*(.*?)\s*$/$1/; # remove whitespace at begin and end of line
  63         s/^(.*?)\s*#.*$/$1/; # remove comments
  64         /^$/ && next;        # skip empty lines
  65
  66         $$functions{$_}++;
  67     }
  68     close(IN);
  69
  70     $output->progress("$configure_ac_file");
  71
  72     my $again = 0;
  73     open(IN, "< $configure_ac_file");
  74     local $/ = "\n";
  75     while($again || (defined($_ = <IN>))) {
  76         $again = 0;
  77         chomp;
  78         if(/^(.*?)\\$/) {
  79             my $current = $1;
  80             my $next = <IN>;
  81             if(defined($next)) {
  82                 # remove trailing whitespace
  83                 $current =~ s/\s+$//;
  84
  85                 # remove leading whitespace
  86                 $next =~ s/^\s+//;
  87
  88                 $_ = $current . " " . $next;
  89
  90                 $again = 1;
  91                 next;
  92             }
  93         }
  94
  95         # remove leading and trailing whitespace
  96         s/^\s*(.*?)\s*$/$1/;
  97
  98         # skip emty lines
  99         if(/^$/) { next; }
 100
 101         # skip comments
 102         if(/^dnl/) { next; }
 103
 104         if(/^AC_CHECK_HEADERS\(\s*([^,\)]*)(?:,|\))?/) {
 105             foreach my $name (split(/\s+/, $1)) {
 106                 $$conditional_headers{$name}++;
 107             }
 108         } elsif(/^AC_CHECK_FUNCS\(\s*([^,\)]*)(?:,|\))?/) {
 109             foreach my $name (split(/\s+/, $1)) {
 110                 $$conditional_functions{$name}++;
 111             }
 112         } elsif(/^AC_FUNC_ALLOCA/) {
 113             $$conditional_headers{"alloca.h"}++;
 114         }
 115
 116     }
 117     close(IN);
 118
 119     $output->progress("$config_h_in_file");
 120
 121     open(IN, "< $config_h_in_file");
 122     local $/ = "\n";
 123     while(<IN>) {
 124         # remove leading and trailing whitespace
 125         s/^\s*(.*?)\s*$/$1/;
 126
 127         # skip emty lines
 128         if(/^$/) { next; }
 129
 130         if(/^\#undef\s+(\S+)$/) {
 131             $$conditionals{$1}++;
 132         }
 133     }
 134     close(IN);
 135
 136     $nativeapi = $self;
 137
 138     return $self;
 139 }
 140
 141 sub is_function {
 142     my $self = shift;
 143     my $functions = \%{$self->{FUNCTIONS}};
 144
 145     my $name = shift;
 146
 147     return $$functions{$name};
 148 }
 149
 150 sub is_conditional {
 151     my $self = shift;
 152     my $conditionals = \%{$self->{CONDITIONALS}};
 153
 154     my $name = shift;
 155
 156     return $$conditionals{$name};
 157 }
 158
 159 sub found_conditional {
 160     my $self = shift;
 161     my $conditional_found = \%{$self->{CONDITIONAL_FOUND}};
 162
 163     my $name = shift;
 164
 165     $$conditional_found{$name}++;
 166 }
 167
 168 sub is_conditional_header {
 169     my $self = shift;
 170     my $conditional_headers = \%{$self->{CONDITIONAL_HEADERS}};
 171
 172     my $name = shift;
 173
 174     return $$conditional_headers{$name};
 175 }
 176
 177 sub is_conditional_function {
 178     my $self = shift;
 179     my $conditional_functions = \%{$self->{CONDITIONAL_FUNCTIONS}};
 180
 181     my $name = shift;
 182
 183     return $$conditional_functions{$name};
 184 }
 185
 186 sub global_report {
 187     my $self = shift;
 188
 189     my $output = \${$self->{OUTPUT}};
 190     my $conditional_found = \%{$self->{CONDITIONAL_FOUND}};
 191     my $conditionals = \%{$self->{CONDITIONALS}};
 192
 193     my @messages;
 194     foreach my $name (sort(keys(%$conditionals))) {
 195         if($name =~ /^const|inline|size_t$/) { next; }
 196
 197         if(0 && !$$conditional_found{$name}) {
 198             push @messages, "config.h.in: conditional $name not used\n";
 199         }
 200     }
 201
 202     foreach my $message (sort(@messages)) {
 203         $output->write($message);
 204     }
 205 }
 206
 207 1;