e9c1d30bbe92d3f4363316d84667cff8513e468b
[pspp] / check-module
1 #!/usr/bin/perl -w
2 # Check a gnulib module.
3
4 # Copyright (C) 2005, 2006 Free Software Foundation, Inc.
5
6 # This file is free software; you can redistribute it and/or modify it
7 # under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful, but
12 # WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14 # General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
19 # 02110-1301, USA.
20
21
22 # Read a module description file and derive the set of files
23 # included directly by any .c or .h file listed in the `Files:' section.
24 # Take the union of all such sets for any dependent modules.
25 # Then, compare that set with the set derived from the names
26 # listed in the various Files: sections.
27
28 # This script makes no attempt to diagnose invalid or empty
29 # module-description files.
30
31 # Written by Jim Meyering
32
33 # FIXME:
34 # for each .m4 file listed in the Files: section(s)
35 # parse it for AC_LIBSOURCES directives, and accumulate the set
36 # of files `required' via all AC_LIBSOURCES.
37 # If this set is not empty, ensure that it contains
38 # the same (.c and .h only?) files as are listed in the Files: sections.
39
40 use strict;
41 use Getopt::Long;
42 #use Coda;
43
44 my $COPYRIGHT_NOTICE = "Copyright (C) 2006 Free Software Foundation, Inc.\n".
45 "This is free software.  You may redistribute copies of it under the terms of\n".
46 "the GNU General Public License <http://www.gnu.org/licenses/gpl.html>.\n".
47 "There is NO WARRANTY, to the extent permitted by law.\n";
48
49 (my $VERSION = '$Revision: 1.5 $ ') =~ tr/[0-9].//cd;
50 (my $ME = $0) =~ s|.*/||;
51
52 use constant ST_INIT => 1;
53 use constant ST_FILES => 2;
54 use constant ST_DEPENDENTS => 3;
55
56 # Parse a module file (returning list of Files: names and
57 # list of dependent-modules.
58 # my ($file, $dep) = parse_module_file $module_file;
59 sub parse_module_file ($)
60 {
61   my ($module_file) = @_;
62
63   open FH, '<', $module_file
64     or die "$ME: can't open `$module_file' for reading: $!\n";
65
66   my %file_set;
67   my %dep_set;
68
69   my $state = ST_INIT;
70   while (defined (my $line = <FH>))
71     {
72       if ($state eq ST_INIT)
73         {
74           if ($line =~ /^Files:$/)
75             {
76               $state = ST_FILES;
77             }
78           elsif ($line =~ /^Depends-on:$/)
79             {
80               $state = ST_DEPENDENTS;
81             }
82         }
83       else
84         {
85           chomp $line;
86           $line =~ s/^\s+//;
87           $line =~ s/\s+$//;
88           if ( ! $line)
89             {
90               $state = ST_INIT;
91               next;
92             }
93
94           if ($state eq ST_FILES)
95             {
96               $file_set{$line} = 1;
97             }
98           elsif ($state eq ST_DEPENDENTS)
99             {
100               $dep_set{$line} = 1;
101             }
102         }
103     }
104   close FH;
105
106   # my @t = sort keys %file_set;
107   # print "files: @t\n";
108   # my @u = sort keys %dep_set;
109   # print "dependents: @u\n";
110
111   return (\%file_set, \%dep_set);
112 }
113
114 # Extract the set of files required for this module, including
115 # those required via dependent modules.
116
117 # Files:
118 # lib/stat.c
119 # m4/stat.m4
120 # lib/foo.h
121 #
122 # Depends-on:
123 # some-other-module
124
125 sub usage ($)
126 {
127   my ($exit_code) = @_;
128   my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
129   if ($exit_code != 0)
130     {
131       print $STREAM "Try `$ME --help' for more information.\n";
132     }
133   else
134     {
135       print $STREAM <<EOF;
136 Usage: $ME [OPTIONS] FILE...
137
138 Read a module description file and derive the set of files
139 included directly by any .c or .h file listed in the `Files:' section.
140 Take the union of all such sets for any dependent modules.
141 Then, compare that set with the set derived from the names
142 listed in the various Files: sections.
143
144 OPTIONS:
145
146    --help             display this help and exit
147    --version          output version information and exit
148
149 EOF
150     }
151   exit $exit_code;
152 }
153
154 sub find_included_lib_files ($)
155 {
156   my ($file) = @_;
157
158   # Special cases...
159   my %special_non_dup = ( 'fnmatch_loop.c' => 1, 'regex.c' => 1 );
160
161   my %inc;
162   open FH, '<', $file
163     or die "$ME: can't open `$file' for reading: $!\n";
164
165   while (defined (my $line = <FH>))
166     {
167       # Ignore test-driver code at end of file.
168       $line =~ m!^\#if(def)? TEST_!
169         and last;
170
171       $line =~ m!^\s*\#\s*include\s+"!
172         or next;
173       $line =~ s///;
174       chomp $line;
175       $line =~ s/".*//;
176       exists $inc{$line} && ! exists $special_non_dup{$line}
177         and warn "$ME: $file: duplicate inclusion of $line\n";
178
179       $inc{$line} = 1;
180     }
181   close FH;
182
183   return \%inc;
184 }
185
186 my %exempt_header =
187   (
188    # Exempt headers like unlocked-io.h that are `#include'd
189    # but not necessarily used.
190    'unlocked-io.h' => 1,
191
192    # Give gettext.h a free pass only when included from lib/error.c,
193    # since we've made that exception solely to make the error
194    # module easier to use -- at RMS's request.
195    'lib/error.c:gettext.h' => 1,
196
197    # The full-read module shares code with the full-write module.
198    'lib/full-write.c:full-read.h' => 1,
199
200    # The safe-write module shares code with the safe-read module.
201    'lib/safe-read.c:safe-write.h' => 1,
202
203    # The use of obstack.h in the hash module is conditional, off by default.
204    'lib/hash.c:obstack.h' => 1,
205
206    # The fts-lgpl module doesn't actually use fts-cycle.c and unistd-safer.h.
207    'lib/fts.c:fts-cycle.c' => 1,
208    'lib/fts.c:unistd-safer.h' => 1,
209   );
210
211 sub check_module ($)
212 {
213   my @m = @_;
214
215   my %file;
216   my %module_all_files;
217   my %dep;
218   my %seen_module;
219
220   while (@m)
221     {
222       my $m = pop @m;
223       # warn "M: $m\n";
224       exists $seen_module{$m}
225         and next;
226       $seen_module{$m} = 1;
227       my ($file, $dep) = parse_module_file $m;
228       push @m, keys %$dep;
229       foreach my $f (keys %$file)
230         {
231           $module_all_files{$f} = 1;
232         }
233     }
234
235   my @t = sort keys %module_all_files;
236   # warn "ALL files: @t\n";
237
238   # Derive from %module_all_files (by parsing the .c and .h files therein),
239   # the list of all #include'd files that reside in lib/.
240   foreach my $f (keys %module_all_files)
241     {
242       $f =~ /\.[ch]$/
243         or next;
244       # FIXME: this is too naive
245       my $inc = find_included_lib_files "../$f";
246       foreach my $i (sort keys %$inc)
247         {
248           my $lib_file = "lib/$i";
249           exists $exempt_header{"$f:$i"}
250             || exists $exempt_header{$i}
251               and next;
252           !exists $module_all_files{$lib_file} && -f "../lib/$i"
253             and warn "$f: $i is `#include'd, but not "
254               . "listed in module's Files: section\n";
255         }
256       #my @t = sort keys %$inc;
257       #print "** $f: @t\n";
258     }
259 }
260
261 {
262   GetOptions
263     (
264      help => sub { usage 0 },
265      version => sub { print "$ME version $VERSION\n$COPYRIGHT_NOTICE"; exit },
266     ) or usage 1;
267
268   @ARGV < 1
269     and (warn "$ME: missing FILE argument\n"), usage 1;
270
271   foreach my $module (@ARGV)
272     {
273       check_module $module;
274     }
275
276   exit 0;
277 }