admin/check-doc-strings

   1 : #-*- Perl -*-
   2 eval 'exec perl -S $0 "$@"' # Portability kludge
   3     if 0;
   4
   5 # Author: Martin Buchholz
   6 # This program is in the public domain.
   7
   8 use strict;
   9 use warnings;
  10 use POSIX;
  11
  12 (my $myName = $0) =~ s@.*/@@; my $usage="
  13 Usage: $myName
  14
  15 Finds DOCSTRING arg mismatches between
  16 formal parameters, docstrings, and lispref texi.
  17
  18 This program is in the public domain.\n";
  19
  20 die $usage if @ARGV;
  21 die $usage unless -r "src/alloc.c" && -d "lisp";
  22
  23 my %texi_funtype;
  24 my %texi_arglist;
  25
  26 my %code_funtype;
  27 my %code_arglist;
  28
  29 sub FileContents {
  30   local $/ = undef;
  31   open (FILE, "< $_[0]") or die "$_[0]: $!";
  32   return scalar <FILE>;
  33 }
  34
  35 sub Show_details {
  36   my ($show_details, $function, $parms, $docstring) = @_;
  37   if ($show_details) {
  38     print "function = $function $parms\n$docstring\n", "-" x 70, "\n";
  39   }
  40 }
  41
  42 sub Check_texi_function {
  43   my ($function, $funtype, $docstring, @parms) = @_;
  44   my %docstring_parm;
  45   my %docstring_word;
  46   my %arglist_parm;
  47   my $show_details = 0;
  48
  49   if (exists $texi_funtype{$function}) {
  50     print "duplicate texidoc: $function @parms\n";
  51     return;                     # later definition likely bogus package def
  52   }
  53
  54   $texi_funtype{$function} = $funtype;
  55   $texi_arglist{$function} = "@parms";
  56
  57   foreach my $parm (@parms) {
  58     next if $parm eq '&optional' || $parm eq '&rest';
  59     $arglist_parm{$parm} = 1;
  60   }
  61
  62   foreach my $parm ($docstring =~ /\@var\{([^{}]+)\}/g) {
  63     $docstring_parm{$parm} = 1;
  64   }
  65
  66   foreach my $hit ($docstring =~ /[^\`]\`[A-Za-z-]+\'/g)
  67     {
  68       print "texi \@code missing: $function: $hit\n";
  69       $show_details = 1;
  70     }
  71
  72   #   (my $raw_docstring = $docstring) =~ s/\@var{[^{}]+}//g;
  73   #   $raw_docstring =~ s/[^a-zA-Z_-]+/ /g;
  74   #   foreach my $word (split (' ', $raw_docstring)) {
  75   #     if ($word =~ /^[A-Z][A-Z-]+$/) {
  76   #       print "Missing \@var: $function: $word\n";
  77   #     }
  78   #   }
  79
  80   foreach my $parm (keys %docstring_parm) {
  81     if (! exists $arglist_parm{$parm}) {
  82       print "bogus texi parm: $function: $parm\n";
  83       $show_details = 1;
  84     }
  85   }
  86
  87   foreach my $parm (keys %arglist_parm) {
  88     if (! exists $docstring_parm{$parm}) {
  89       print "undocumented texi parm: $function: $parm\n";
  90       $show_details = 1;
  91     }
  92   }
  93
  94   Show_details $show_details, $function, "@parms", $docstring;
  95 }
  96
  97 sub Check_function {
  98   my ($function, $funtype, $docstring, @parms) = @_;
  99   my %docstring_parm;
 100   my %arglist_parm;
 101   my $show_details = 0;
 102
 103   if (exists $code_funtype{$function}) {
 104     print "duplicate codedef: $function @parms\n";
 105     return;                     # later definition likely bogus package def
 106   }
 107
 108   $code_funtype{$function} = $funtype;
 109   $code_arglist{$function} = "@parms";
 110   #foreach my $parm ($parms =~ /\b[a-z0-9-]{3,}\b/g) {
 111   #  $arglist_parm{$parm} = 1;
 112   #}
 113   foreach my $parm (@parms) {
 114     next if $parm eq '&optional'
 115       || $parm eq '&rest'
 116       || $parm eq 'Lisp-Object';
 117     $arglist_parm{$parm} = 1;
 118   }
 119   my $doc_tmp = $docstring;
 120   $doc_tmp =~ s/[^A-Za-z0-9_-]/ /g;
 121   foreach my $parm (split (' ', $doc_tmp)) {
 122     if ($parm =~ /^[A-Z][A-Z0-9-]*$/) {
 123       next if $parm =~ /I18N/;
 124       next if $parm =~ /M17N/;
 125       $parm =~ tr[A-Z][a-z];
 126       $docstring_parm{$parm} = 1;
 127     }
 128   }
 129   #  foreach my $parm ($docstring =~ /\b[A-Z0-9-]{1,}\b/g) {
 130   #    next if $parm =~ /-$/;
 131   #    $parm =~ tr[A-Z][a-z];
 132   #    $docstring_parm{$parm} = 1;
 133   #  }
 134   foreach my $parm (keys %docstring_parm) {
 135     next if $parm eq 'tty';
 136     next if $parm eq 'fsf';
 137     next if $parm eq 'note';
 138     next if $parm eq 'warning';
 139     next if $parm eq 'bug';
 140     next if $parm eq 'ascii';
 141     next if $parm eq 'iso';
 142     next if $parm eq 'and';
 143     next if $parm eq 'absolutely';
 144     next if $parm eq 'doc';
 145     next if $parm eq 'user';
 146     next if $parm eq 'not';
 147     next if $parm eq 'must';
 148     next if $parm eq 'nil';
 149     next if $parm eq 'esc';
 150     next if $parm eq 'lfd';
 151     next if $parm eq 'gpm';
 152     next if $parm eq 'primary';
 153     next if $parm eq 'secondary';
 154     next if $parm eq 'clipboard';
 155     next if $parm eq 'bbdb';
 156     next if $parm eq 'dos';
 157     next if $parm eq 'erc';
 158     next if $parm eq 'exif';
 159     next if $parm eq 'ldap';
 160     next if $parm eq 'ime';
 161     next if $parm eq 'rfc';
 162     next if $parm eq 'ms-dos';
 163     next if $parm eq 'url';
 164     next if $parm eq 'w32';
 165     next if $parm eq 'todo'; # org-mode
 166     next if $parm eq 'done'; # org-mode
 167     next if $parm eq 'waiting'; #org-mode
 168     next if $parm eq 'ordered'; #org-mode
 169     next if $parm eq 'deadline'; #org-mode
 170     next if $parm eq 'scheduled'; #org-mode
 171     next if length $parm < 3;
 172     if (! exists $arglist_parm{$parm}) {
 173       print "bogus parm: $function: $parm\n";
 174       $show_details = 1;
 175     }
 176   }
 177   foreach my $parm (keys %arglist_parm) {
 178     if (! exists $docstring_parm{$parm}) {
 179       print "Undocumented parm: $function: $parm\n";
 180       $show_details = 1;
 181     }
 182   }
 183
 184   if ($docstring !~ /[\]}!\)\.]\s*\Z/m &&
 185       $docstring =~ /\S/ &&
 186       $docstring !~ /Keywords supported/)
 187     {
 188       print "Missing trailing period: $function\n";
 189       $show_details = 1;
 190     }
 191
 192   if (exists $texi_arglist{$function}
 193       and "@parms" ne $texi_arglist{$function}
 194       and not ("@parms" eq 'int nargs Lisp-Object *args'
 195                && $texi_arglist{$function} =~ /&rest/)) {
 196     my @texi_parms = split (' ', $texi_arglist{$function});
 197     my @a = ("@parms" =~ /&optional/g);
 198     my @b = ("@parms" =~ /&rest/g);
 199     my @c = ("@texi_parms" =~ /&optional/g);
 200     my @d = ("@texi_parms" =~ /&rest/g);
 201     if (@parms != @texi_parms
 202         || (@a != @c) || (@b != @d)) {
 203       print "serious mismatch: $function: @parms --- @texi_parms\n";
 204     } else {
 205       print "texi mismatch: $function: @parms --- $texi_arglist{$function}\n";
 206     }
 207     $show_details = 1;
 208   }
 209
 210   if (exists $texi_funtype{$function}
 211       && $texi_funtype{$function} ne $funtype) {
 212     print "interactiveness mismatch: $function: $funtype --- $texi_funtype{$function}\n";
 213     $show_details = 1;
 214   }
 215
 216   Show_details $show_details, $function, "@parms", $docstring;
 217 }
 218
 219 my $lisprefdir = "doc/lispref";
 220 die "Can't find lispref texi directory.\n" unless -d $lisprefdir;
 221
 222 open (FIND, "find $lisprefdir -name '*.texi' -print |") or die;
 223 while (my $file = <FIND>) {
 224   my @matches = ((FileContents $file) =~
 225                  /\@(def(?:fn|un))([^\n]+)\n(.*?)\n\@end def(?:un|fn)/sgo);
 226   #              /^\@(def(?:un|fn))\s+(.*)\n([.|\n]*?)^\@end def(?:un|fn)\n/mgo);
 227   while (@matches) {
 228     my ($defform, $defn, $docstring) = splice (@matches, 0, 3);
 229     #print "defform = $defform\n";
 230     #print "defn = $defn\n";
 231     #print "docstring = $docstring\n";
 232     my ($function, @parms, $funtype);
 233     if ($defform eq 'defun') {
 234       ($funtype, $function, @parms) = ('Function', split (' ', $defn));
 235     } else {
 236       die unless $defform eq 'deffn';
 237       ($funtype, $function, @parms) = split (' ', $defn);
 238     }
 239     next if $funtype eq '{Syntax' or $funtype eq '{Prefix';
 240
 241     Check_texi_function $function, $funtype, $docstring, @parms;
 242   }
 243 }
 244
 245 open (FIND, "find src -name '*.c' -print |") or die;
 246 while (my $file = <FIND>) {
 247   my @matches =
 248     ((FileContents $file) =~
 249      /\b
 250       DEFUN\s*\(\s*
 251       ## $function
 252       \"((?:[^\\\"]|\\.)+)\"\s*,
 253       \s*\S+\s*, \s*\S+\s*,
 254       ## $minargs
 255       \s*(\S+)\s*,
 256       ## $maxargs
 257       \s*(\S+)\s*,
 258       ## $interactive
 259       \s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,
 260       ## $docstring
 261       \s*doc:\s*\/\*\s*(.*?)\s*\*\/
 262       # attributes -- skip
 263       (?:\s*attributes:\s*
 264           (?:noreturn|const)
 265           \s*)?
 266       \s*\)
 267       ### $parms
 268       \s*\(
 269       ([^()]*)
 270       \)
 271      /sgox);
 272   while (@matches) {
 273     my ($function, $minargs, $maxargs, $interactive, $docstring, $parms) = splice (@matches, 0, 6);
 274     $docstring =~ s/^\n+//s;
 275     $docstring =~ s/\n+$//s;
 276     $parms =~ s/,/ /g;
 277     my @parms = $parms eq 'void' ? () : split (' ', $parms);
 278     for (@parms) { tr/_/-/; s/-$//; }
 279     if ($parms !~ /Lisp_Object/) {
 280       if ($minargs < @parms) {
 281         if ($maxargs =~ /^\d+$/) {
 282           die "$function: $maxargs"
 283             unless $maxargs eq @parms;
 284           splice (@parms, $minargs, 0, '&optional');
 285         }
 286       }
 287     }
 288     my $funtype = ($interactive =~ /\"/ ? 'Command' : 'Function');
 289     Check_function $function, $funtype, $docstring, @parms;
 290   }
 291 }
 292
 293 my @pkgs = ();
 294 open (FIND, "find lisp @pkgs -name '*.el' -print |") or die;
 295 while (my $file = <FIND>) {
 296   my $contents = FileContents $file;
 297   $contents =~ s/(?:\s|;);.*//mog;
 298   my @matches =
 299     ($contents =~
 300      /\((def(?:un|subst|macro))\s+(\S+)\s+\(([^()]*)\)\s+\"((?:[^\\\"]|\\.)+)\"(.*?)\)/sgo);
 301   while (@matches) {
 302     my ($defform, $function, $parms, $docstring, $code_fragment) = splice (@matches, 0, 5);
 303
 304     my $funtype =
 305       $defform eq 'defmacro' ? 'Macro' :
 306         $code_fragment =~ /^\s*\(interactive\b/so ? 'Command' :
 307           'Function';
 308
 309     $docstring =~ s/^\n+//s;
 310     $docstring =~ s/\n+$//s;
 311
 312     my @parms = split (' ', $parms);
 313
 314     Check_function $function, $funtype, $docstring, @parms;
 315   }
 316 }
 317
 318 open (FIND, "find lisp @pkgs -name '*.el' -print |") or die;
 319 while (my $file = <FIND>) {
 320   my $contents = FileContents $file;
 321   $contents =~ s/(?:\s|;);.*//mog;
 322
 323   my @matches = ($contents =~ /^\((?:defalias|fset|define-function)\s+\'([A-Za-z0-9_-]+)\s+\'([A-Za-z0-9_-]+)/mog);
 324   while (@matches) {
 325     my ($alias, $aliasee) = splice (@matches, 0, 2);
 326     print "alias $alias aliasee $aliasee\n";
 327     if (exists $code_funtype{$aliasee}) { $code_funtype{$alias} = $code_funtype{$aliasee}; }
 328     if (exists $code_arglist{$aliasee}) { $code_arglist{$alias} = $code_arglist{$aliasee}; }
 329   }
 330 }
 331
 332 foreach my $fun (sort keys %texi_funtype) {
 333   if (not exists $code_funtype{$fun}) {
 334     print "nuke-this-doc: $fun $texi_funtype{$fun}\n";
 335   }
 336 }