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.7 $ ') =~ 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,
 160                           'regex.c' => 1, 'at-func.c' => 1 );
 161
 162   my %inc;
 163   open FH, '<', $file
 164     or die "$ME: can't open `$file' for reading: $!\n";
 165
 166   while (defined (my $line = <FH>))
 167     {
 168       # Ignore test-driver code at end of file.
 169       $line =~ m!^\#if(def)? TEST_!
 170         and last;
 171
 172       $line =~ m!^\s*\#\s*include\s+"!
 173         or next;
 174       $line =~ s///;
 175       chomp $line;
 176       $line =~ s/".*//;
 177       exists $inc{$line} && ! exists $special_non_dup{$line}
 178         and warn "$ME: $file: duplicate inclusion of $line\n";
 179
 180       $inc{$line} = 1;
 181     }
 182   close FH;
 183
 184   return \%inc;
 185 }
 186
 187 my %exempt_header =
 188   (
 189    # Exempt headers like unlocked-io.h that are `#include'd
 190    # but not necessarily used.
 191    'unlocked-io.h' => 1,
 192
 193    # Give gettext.h a free pass only when included from lib/error.c,
 194    # since we've made that exception solely to make the error
 195    # module easier to use -- at RMS's request.
 196    'lib/error.c:gettext.h' => 1,
 197
 198    # The full-read module shares code with the full-write module.
 199    'lib/full-write.c:full-read.h' => 1,
 200
 201    # The safe-write module shares code with the safe-read module.
 202    'lib/safe-read.c:safe-write.h' => 1,
 203
 204    # The use of obstack.h in the hash module is conditional, off by default.
 205    'lib/hash.c:obstack.h' => 1,
 206
 207    # C files in the gc module have conditional includes.
 208    'lib/gc-gnulib.c:des.h' => 1,
 209    'lib/gc-gnulib.c:arcfour.h' => 1,
 210    'lib/gc-gnulib.c:arctwo.h' => 1,
 211    'lib/gc-gnulib.c:md2.h' => 1,
 212    'lib/gc-gnulib.c:md4.h' => 1,
 213    'lib/gc-gnulib.c:md5.h' => 1,
 214    'lib/gc-gnulib.c:rijndael.h' => 1,
 215    'lib/gc-gnulib.c:sha1.h' => 1,
 216    'lib/gc-gnulib.c:rijndael-api-fst.h' => 1,
 217    'lib/gc-gnulib.c:hmac.h' => 1,
 218    'lib/gc-libgcrypt.c:md2.h' => 1,
 219
 220    # The fts-lgpl module doesn't actually use fts-cycle.c and unistd-safer.h.
 221    'lib/fts.c:fts-cycle.c' => 1,
 222    'lib/fts.c:unistd-safer.h' => 1,
 223   );
 224
 225 sub check_module ($)
 226 {
 227   my @m = @_;
 228
 229   my %file;
 230   my %module_all_files;
 231   my %dep;
 232   my %seen_module;
 233
 234   while (@m)
 235     {
 236       my $m = pop @m;
 237       # warn "M: $m\n";
 238       exists $seen_module{$m}
 239         and next;
 240       $seen_module{$m} = 1;
 241       my ($file, $dep) = parse_module_file $m;
 242       push @m, keys %$dep;
 243       foreach my $f (keys %$file)
 244         {
 245           $module_all_files{$f} = 1;
 246         }
 247     }
 248
 249   my @t = sort keys %module_all_files;
 250   # warn "ALL files: @t\n";
 251
 252   # Derive from %module_all_files (by parsing the .c and .h files therein),
 253   # the list of all #include'd files that reside in lib/.
 254   foreach my $f (keys %module_all_files)
 255     {
 256       $f =~ /\.[ch]$/
 257         or next;
 258       # FIXME: this is too naive
 259       my $inc = find_included_lib_files "../$f";
 260       foreach my $i (sort keys %$inc)
 261         {
 262           my $lib_file = "lib/$i";
 263           exists $exempt_header{"$f:$i"}
 264             || exists $exempt_header{$i}
 265               and next;
 266           !exists $module_all_files{$lib_file} && -f "../lib/$i"
 267             and warn "$f: $i is `#include'd, but not "
 268               . "listed in module's Files: section\n";
 269         }
 270       #my @t = sort keys %$inc;
 271       #print "** $f: @t\n";
 272     }
 273 }
 274
 275 {
 276   GetOptions
 277     (
 278      help => sub { usage 0 },
 279      version => sub { print "$ME version $VERSION\n$COPYRIGHT_NOTICE"; exit },
 280     ) or usage 1;
 281
 282   @ARGV < 1
 283     and (warn "$ME: missing FILE argument\n"), usage 1;
 284
 285   foreach my $module (@ARGV)
 286     {
 287       check_module $module;
 288     }
 289
 290   exit 0;
 291 }