check-module

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