xapian-maintainer-tools/xapian-check-patch

   1 #! /usr/bin/perl -w
   2 # Copyright (c) 2007-2018 Olly Betts
   3 #
   4 # Permission is hereby granted, free of charge, to any person obtaining a copy
   5 # of this software and associated documentation files (the "Software"), to
   6 # deal in the Software without restriction, including without limitation the
   7 # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
   8 # sell copies of the Software, and to permit persons to whom the Software is
   9 # furnished to do so, subject to the following conditions:
  10 #
  11 # The above copyright notice and this permission notice shall be included in
  12 # all copies or substantial portions of the Software.
  13 #
  14 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  15 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  16 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  17 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  18 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  19 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
  20 # IN THE SOFTWARE.
  21
  22 require 5.000;
  23 use strict;
  24 use POSIX;
  25
  26 if (defined $ARGV[0] && $ARGV[0] eq '--help') {
  27     print <<END;
  28 Syntax: $0 [PATCH]...
  29
  30 Nit-pick Xapian patches.
  31
  32 A patch can be supplied on stdin, or one or more patch files listed on the
  33 command line.
  34
  35 Produces output suitable for use with vim's quick-fix mode, and similar
  36 features in other editors.
  37
  38 Example usage:
  39
  40 git diff master.. | xapian-check-patch > tmp.qf
  41 vim -q tmp.qf
  42 END
  43     exit 0;
  44 }
  45
  46 my ($fnm, $lineno);
  47 my %count;
  48
  49 sub diagnostic {
  50     my ($type, $msg, $fullline) = @_;
  51     print "$fnm:$lineno: $type: $msg";
  52     if (defined $fullline) {
  53         print ": $fullline";
  54     } else {
  55         print "\n";
  56     }
  57     ++$count{$type};
  58 }
  59
  60 my $add_lines = 0;
  61 my $del_lines = 0;
  62 my $files = 0;
  63 # SVN property changes don't have an "Index: [...]" line.
  64 my $want_tabs = -1;
  65 my $check_trailing = 0;
  66 my $check_space_tab = 0;
  67 my $in_comment = 0;
  68 my $lang;
  69 my $header_guard_macro;
  70 my $last_first_char = '';
  71 my $in_ternary;
  72 my $preproc;
  73 my $preproc_continuation;
  74 my ($top_level, $next_top_level); # undef for unknown, 0 for no, 1 for yes.
  75 my $last_line_blank = 0;
  76 while (<>) {
  77     if (defined $next_top_level) {
  78         $top_level = $next_top_level;
  79         $next_top_level = undef;
  80     }
  81
  82     if (/^Index: (.+)/ || m!^diff --git a/.+ b/(.+)!) {
  83         ++$files;
  84         $fnm = $1;
  85         $lineno = 1;
  86         $lang = undef;
  87         $in_comment = 0;
  88         $header_guard_macro = undef;
  89         $in_ternary = 0;
  90         $preproc = 0;
  91         $preproc_continuation = 0;
  92         $top_level = undef;
  93         # Don't know!
  94         $want_tabs = -1;
  95         if ($fnm =~ /\.cc$/) {
  96             if ($fnm !~ m!\b(?:cdb|portability/)! &&
  97                 $fnm !~ m!\bcommon/getopt\.cc$! &&
  98                 $fnm !~ m!\bomega/md5\.cc$! &&
  99                 $fnm !~ m!\bcommon/msvc_dirent\.cc$!) {
 100                 $lang = 'c++';
 101                 $want_tabs = 1 unless ($fnm =~ m!\blanguages/steminternal\.cc$!);
 102             }
 103         } elsif ($fnm =~ /\.c$/) {
 104             if ($fnm !~ m!\blanguages/compiler/! &&
 105                 $fnm !~ m!/lemon\.c$! &&
 106                 $fnm !~ m!/xapdep\.c$!) {
 107                 $lang = 'c';
 108                 $want_tabs = 1;
 109             }
 110         } elsif ($fnm =~ /\.h$/) {
 111             if ($fnm !~ m!\binclude/xapian/intrusive_ptr\.h! &&
 112                 $fnm !~ m!\blanguages/compiler/! &&
 113                 $fnm !~ m!\bcommon/msvc_dirent\.h$! &&
 114                 $fnm !~ m!\bcommon/heap\.h$!) {
 115                 $lang = 'h';
 116                 $want_tabs = 1 unless ($fnm =~ m!/omega/cdb!);
 117             }
 118         } elsif ($fnm =~ /\.py(?:\.in)?$/) {
 119             $lang = 'py';
 120             $want_tabs = 0;
 121         } elsif ($fnm =~ m!(?:^|/)ChangeLog\b!) {
 122             $lang = 'changelog';
 123             $want_tabs = 1;
 124         }
 125         $check_trailing =
 126             $fnm !~ /\.sbl$/ &&
 127             $fnm !~ m!\bcommon/msvc_dirent\.! &&
 128             $fnm !~ m!/lemon\.c$! &&
 129             $fnm !~ m!/queryparser\.lt$! &&
 130             $fnm !~ m!\bcdb! &&
 131             $fnm !~ m!/testdata/etext\.txt$!;
 132         $check_space_tab =
 133             $fnm !~ /\.patch$/ &&
 134             $fnm !~ /\.sbl$/;
 135         # print STDERR "$fnm: lang=" . ($lang // "UNKNOWN") . "\;
 136         next;
 137     }
 138     my $pre3 = substr($_, 0, 3);
 139     if ($pre3 eq '@@ ') {
 140         /^\@\@ -\d+,\d+ \+(\d+),\d+\b/ and $lineno = $1;
 141         $next_top_level = ($lineno == 1) ? 1 : undef;
 142         $in_comment = 0;
 143         next;
 144     }
 145     if ($pre3 eq '---' || $pre3 eq '+++') {
 146         next;
 147     }
 148
 149     my $line_blank = /^.\s*$/;
 150     if (!$line_blank) {
 151         $next_top_level = (/^.\s/ ? 0 : 1);
 152     }
 153
 154     my $fullline = $_;
 155     if (defined $lang && ($lang eq 'c++' || $lang eq 'h' || $lang eq 'c')) {
 156         # Uncomment commented out parameter names: foo(int /*bar*/) -> foo(int bar)
 157         s!/\*([A-Za-z_][A-Za-z_0-9]*)\*/([,)])!$1$2!g;
 158
 159         # Check for comments without a space before the comment text.
 160         if (m!^\+.*\s/[*/]{1,2}[A-Za-z0-9]!) {
 161             diagnostic('error', "Missing space between comment characters and comment text", $fullline);
 162         }
 163
 164         # Trim comments:
 165         if (s!/(?:\*.*?\*/|/.*)!!g) {
 166             s/\s+$//;
 167         }
 168         if (s!/\*.*!!g) {
 169             s/\s+$//;
 170             $in_comment = 1;
 171         }
 172         # Trim content of comments ending on this line:
 173         if (s!^(.).*\*/!$1*/!) {
 174             $in_comment = 0;
 175         }
 176         if ($in_comment) {
 177             $_ = '';
 178         } else {
 179             # Drop comment content for "*" continuation lines (when /* isn't in hunk):
 180             s/^(.)(\s*\*).*/$1$2/;
 181         }
 182     } elsif (defined $lang && $lang eq 'py') {
 183         # Trim comments:
 184         if (s!#.*!!g) {
 185             s/\s+$//;
 186         }
 187     }
 188
 189     # Replace multiple spaces before line continuation marker:
 190     s!  +\\$! \\!;
 191
 192     if (defined $lang && ($lang eq 'c++' || $lang eq 'h' || $lang eq 'c')) {
 193         if (substr($_, 0, 1) eq '+') {
 194             my $expandedline = '';
 195             for my $i (1..length($fullline) - 1) {
 196                 my $ch = substr($fullline, $i, 1);
 197                 if ($ch eq "\t") {
 198                     $expandedline .= ('.' x (8 - length($expandedline) % 8));
 199                 } else {
 200                     $expandedline .= $ch;
 201                 }
 202             }
 203             chomp($expandedline);
 204             if (length($expandedline) > 80 &&
 205                 # Logging annotations aren't really for human eyes.
 206                 !/^\+[ \t]*LOGCALL/ &&
 207                 # Don't force wrapping of a long #error message.
 208                 !/^#\d*(error|warning)\b/) {
 209                 diagnostic('error', "Line extends beyond column 80 (to column ".length($expandedline).")", $fullline);
 210             }
 211         }
 212         if (m,^\+\s+LOGCALL(?:_[A-Z0-9]+)*\([^"]*"[^"]*(?<!operator)\(,) {
 213             diagnostic('error', "Don't include parentheses in debug logging method/class name", $fullline);
 214         }
 215         # Replace string literals containing escaped quotes:
 216         if (/['"]/) {
 217             my $quote = substr($_, $-[0], 1);
 218             my $start = $+[0];
 219             my $i = $start;
 220             my $esc = 0;
 221 QUOTELOOP:  while (1) {
 222                 if ($i >= length($_)) {
 223                     $_ = substr($_, 0, $start) . "X\n";
 224                     last;
 225                 }
 226                 my $c = substr($_, $i, 1);
 227                 if ($c eq $quote) {
 228                     $_ = substr($_, 0, $start) . "X" . substr($_, $i);
 229                     $i = $start + 2;
 230                     # See if there's another string after this one:
 231                     while ($i != length($_)) {
 232                         $c = substr($_, $i, 1);
 233                         ++$i;
 234                         if ($c eq '"' || $c eq "'") {
 235                             $quote = $c;
 236                             $start = $i;
 237                             $esc = 0;
 238                             next QUOTELOOP;
 239                         }
 240                     }
 241                     last;
 242                 }
 243                 if ($c eq '\\') {
 244                     ++$i;
 245                     $c = substr($_, $i, 1);
 246                     if ($c eq 'x') {
 247                         ++$i while (substr($_, $i, 1) =~ /^[A-Fa-f0-9]$/);
 248                         next;
 249                     } elsif ($c =~ /^[0-7]/) {
 250                         my $j = $i;
 251                         ++$i while ($i - $j <= 3 && substr($_, $i, 1) =~ /^[0-7]$/);
 252                         next;
 253                     } elsif ($c eq '"' || $c eq "'") {
 254                         ++$esc;
 255                     }
 256                 }
 257                 ++$i;
 258             }
 259         }
 260     }
 261
 262     if ($check_trailing && $fullline =~ /^\+.*[ \t]$/) {
 263         diagnostic('error', "added/changed line has trailing whitespace", $fullline);
 264     }
 265     if ($check_space_tab && /^\+.* \t/) {
 266         diagnostic('error', "added/changed line has space before tab", $fullline);
 267     }
 268     if ($want_tabs == 1 and /^\+\t* {8}/) {
 269         diagnostic('error', "added/changed line uses spaces for indentation rather than tab", $fullline);
 270     }
 271     if (!$want_tabs and /^\+ *\t/) {
 272         diagnostic('error', "added/changed line uses tab for indentation rather than spaces", $fullline);
 273     }
 274     if ((!defined $lang || $lang ne 'changelog') && $fullline =~ /^([-+]).*\bFIX(?:ME)\b/) {
 275         # Break up the string in the regexp above and messages below to avoid
 276         # this triggering on its own code!
 277         if ($1 eq '-') {
 278             # Not an error, but interesting information.
 279             diagnostic('info', "FIX"."ME removed", $fullline);
 280         } else {
 281             # Not an error, but not good.
 282             diagnostic('warning', "FIX"."ME added", $fullline);
 283         }
 284     }
 285     if (defined $lang && $lang ne 'changelog' && /^\+.*\\([abcefp]|brief|code|deprecated|endcode|exception|file|internal|li|param|private|return|todo)\b/) {
 286         diagnostic('error', "Doxygen command '\\$1' introduced by '\\' not '\@'", $fullline);
 287     }
 288     if (defined $lang && $lang ne 'changelog' && /^\+.*@\s+([abcefp]|brief|code|deprecated|endcode|exception|file|internal|li|param|private|return|todo)\b/) {
 289         diagnostic('error', "Broken Doxygen command: whitespace between '\@' and '$1'", $fullline);
 290     }
 291     if (defined $lang && ($lang eq 'c++' || $lang eq 'h' || $lang eq 'c')) {
 292         if ($last_line_blank) {
 293             if ($line_blank) {
 294                 # Allow multiple blank lines at the top level for now.
 295                 diagnostic('error', "Extra blank line", $fullline) unless ($top_level // 1);
 296             } elsif (/^.\s+\}$/) {
 297                 # Closing } of a namespace often has a blank line before it,
 298                 # and that seems reasonable.
 299                 diagnostic('error', "Blank line at end of block", $fullline) unless ($top_level // 1);
 300             }
 301         }
 302
 303         if (/^([-+ ])(\s*)\#/) {
 304             # Avoid misfiring for something like:
 305             # #define FOO(x) \
 306             #     #x
 307             if (!$preproc_continuation) {
 308                 if ($1 eq '+' && $2 ne '') {
 309                     diagnostic('error', "Whitespace before '#' on preprocessor line", $fullline);
 310                 }
 311             }
 312             $preproc = 1;
 313             $preproc_continuation = /\\$/;
 314         } elsif ($preproc_continuation) {
 315             $preproc_continuation = /\\$/;
 316         } else {
 317             $preproc = 0;
 318         }
 319         if ($check_space_tab && /^\+( (?:|  |    |      ))[^ \t#].*(?:[^)];|[^);,])\n/) {
 320             # Exclude lines ending ');', ')', or ',' to avoid reporting for wrapped function arguments.
 321             diagnostic('error', "line indented by ".length($1)." spaces", $fullline);
 322         }
 323         if (m!^\+.*\b([A-Za-z_][A-Za-z_0-9]*)\s+\(! &&
 324             $1 !~ /^(bool|case|catch|double|for|if|int|return|switch|throw|void|while)$/) {
 325             if (!$preproc) {
 326                 diagnostic('error', "Whitespace between '$1' and '('", $fullline);
 327             } else {
 328                 # FIXME: We skip preprocessor lines for now to avoid triggering
 329                 # on things like «#define FOUR (2+2)» but it would be good to
 330                 # catch «#define FOO(x) foo (x)»
 331             }
 332         }
 333         if (m!^\+\s*(case|catch|class|do|for|if|namespace|struct|switch|try|union)\b([^ ]| \s)!) {
 334             diagnostic('error', "'$1' not followed by exactly one space", $fullline);
 335         }
 336         if (m!^\+.*;[^\s\\]!) {
 337             diagnostic('error', "Missing space after ';'", $fullline);
 338         }
 339         if (m!^\+.*[^(;]\s;!) {
 340             # Stuff like this is OK: for ( ; ; ) {
 341             # though for that exact case I'd suggest: while (true) {
 342             diagnostic('error', "Whitespace before ';'", $fullline);
 343         }
 344         if (m!^\+.*?\b(return)\b([^ ;]| \s)!) {
 345             diagnostic('error', "'$1' not followed by exactly one space", $fullline);
 346         }
 347         if (m!^\+.*?\b(else)\b([^ \n]| \s)!) {
 348             diagnostic('error', "'$1' not followed by exactly one space", $fullline);
 349         }
 350         if (m!^\+.*?\b(while)\b([^ ]| \s)!) {
 351             diagnostic('error', "'$1' not followed by exactly one space", $fullline);
 352         }
 353         if (m!^\+.*?(?:}|}\s{2,}|}\t|^[^}]*)\b(catch)\b!) {
 354             diagnostic('error', "'$1' not preceded by exactly '} '", $fullline);
 355         }
 356         if (m!^\+.*?(?:}|}\s{2,}|}\t)\b(else|while)\b!) {
 357             diagnostic('error', "'}' and '$1' not separated by exactly one space", $fullline);
 358         }
 359         if (m!^\+.*\((?: [^;]|\t)!) {
 360             # Allow: for ( ; i != 10; ++i)
 361             diagnostic('error', "Whitespace after '('", $fullline);
 362         }
 363         if (m!^\+.*\H.*\h\)!) {
 364             diagnostic('error', "Whitespace before ')'", $fullline);
 365         }
 366         if (m!^\+.*;\s*(\w+)([-+]{2})\)!) {
 367             diagnostic('error', "Prefer '$2$1' to '$1$2'", $fullline);
 368         }
 369         if (m,^\+\s*[^#].*[\w)](?!-[->]|\+\+)((?:\&\&|\|\||<<|>>|[-+/*%~=<>!&|^])=?|[?]),) {
 370             my @pre = @-;
 371             my @post = @+;
 372             my $op = $1;
 373             if (substr($_, $pre[1] - 8, 8) eq 'operator') {
 374                 # operator*() etc
 375             } elsif ($op eq '>' && substr($_, 0, $pre[1]) =~ /[A-Za-z0-9_]</) {
 376                 # y = static_cast<char>(x);
 377             } elsif ($op eq '>') {
 378             } elsif ($op eq '<' && substr($_, $pre[1] - 1, 1) =~ /^[A-Za-z0-9_]$/ && substr($_, $post[1]) =~ />/) {
 379                 # y = static_cast<char>(x);
 380             } elsif ($op eq '<' &&
 381                      substr($_, 0, $pre[1]) =~ /\b(?:enable_if|list|map|multimap|multiset|priority_queue|set|template|unordered_map|unordered_set|vector)$/) {
 382                 # y = priority_queue<Foo*,
 383                 #                    Bar>;
 384                 # template<typename A,
 385                 #          typename B>
 386             } elsif ($op eq '&&' && substr($_, 0, $pre[1]) =~ /\b(?:auto|bool|double|float|int(?:\d+_t)?|long|string|uint\d+_t|unsigned|[A-Z][A-Za-z0-9_]*)$/) {
 387                 # auto&& x;
 388                 # method(Class&& foo);
 389             } elsif (($op eq '<<' || $op eq '>>') &&
 390                 substr($_, 0, $pre[1]) =~ /\b(?:0x[0-9a-fA-F]+|[0-9]+)$/ &&
 391                 substr($_, $post[1]) =~ /^(?:0x[0-9a-fA-F]+|[0-9]+)\b/) {
 392                 # 0x00b1<<26
 393             } elsif (($op eq '-' || $op eq '+') &&
 394                 substr($_, 0, $pre[1]) =~ /[0-9]\.?e$/) {
 395                 # 1.2e-3, 7.e+3
 396             } elsif ($op eq '>>' &&
 397                 /[A-Za-z0-9_]<.+</) {
 398                 # vector<vector<int>> v;
 399             } elsif ($op =~ /^[*&|]$/) {
 400                 # FIXME: *: const char* x;
 401                 # FIXME: &: const char& x;
 402                 # FIXME: |: FOO|BAR
 403             } else {
 404                 diagnostic('error', "Missing space before '$op'", $fullline);
 405             }
 406         }
 407         if (m@^\+\s*[^#\s].*?((?:\&\&|\|\||<<|>>|[-+/*%~=<>!&|^])=?|[?:,])(?<!(?:-[->]|\+\+|::))(?:[\w\(\.\{!"']| \s)@) {
 408             my @pre = @-;
 409             my @post = @+;
 410             my $op = $1;
 411             if ($op eq '~' && substr($_, $post[1]) =~ /^[A-Za-z][A-Za-z0-9_]*\(/) {
 412                 # Destructor - e.g. ~Foo();
 413             } elsif (($op eq '-' || $op eq '+' || $op eq '!' || $op eq '~') &&
 414                 substr($_, 0, $pre[1]) =~ m@(?:[-+/*%~=<>&|,;?:] |[\[(]|\b(?:return|case) |^\+\s*)$@) {
 415                 # Unary -, +, !, ~: e.g. foo = +1; bar = x * (-y); baz = a * -b;
 416             } elsif ($op eq ',' && (
 417                 /\b(?:AssertRel(?:Paranoid)?|TEST_REL)\(/ ||
 418                 /{[^()]*}/)) {
 419                 # AssertRel(a,<,b);
 420             } elsif ($op eq '>>' &&
 421                 /[A-Za-z0-9_]<.+</) {
 422                 # vector<vector<int>>&
 423             } elsif ($op =~ /^[*&<>|]$/) {
 424                 # FIXME: *: const char *x;
 425                 # FIXME: *: const char &x;
 426                 # FIXME: < >: y = static_cast<char>(x);
 427                 # FIXME: |: FOO|BAR
 428             } elsif (substr($_, $pre[1] - 8, 8) eq 'operator') {
 429                 # operator==() etc
 430             } elsif (($op eq '<<' || $op eq '>>') &&
 431                 substr($_, 0, $pre[1]) =~ /\b(?:0x[0-9a-fA-F]+|[0-9]+)$/ &&
 432                 substr($_, $post[1]) =~ /^(?:0x[0-9a-fA-F]+|[0-9]+)\b/) {
 433                 # 0x00b1<<26
 434             } elsif (($op eq '-' || $op eq '+') &&
 435                 substr($_, 0, $pre[1]) =~ /[0-9]\.?e$/) {
 436                 # 1.2e-3, 7.e+3
 437             } else {
 438                 diagnostic('error', "Should have exactly one space after '$op'", $fullline);
 439             }
 440         }
 441         if (/^\+.*;;\s*$/) {
 442             diagnostic('error', "Extra ';' at end of line", $fullline);
 443         }
 444         if (m@^\+[^#]*?[^#\h] +(,|->)@) {
 445             diagnostic('error', "Space before '$1'", $fullline);
 446         }
 447         if (m,^\+[^#]*?[^#\h]  ,) {
 448             diagnostic('error', "Multiple spaces", $fullline);
 449         }
 450         if (m!^\+(?:.*[;{])?\s*/[/*]{1,2}\w!) {
 451             diagnostic('error', "added/changed line has comment without whitespace before the text", $fullline);
 452         }
 453         if (m!^\+.*?\)\{!) {
 454             diagnostic('error', "No space between ')' and '{'", $fullline);
 455         }
 456         if ($fnm !~ m!/(?:md5|posixy_wrapper|perftest)\.cc$! &&
 457             m,^\+.*[^\w\.>]([a-z][a-z0-9]*[A-Z]\w*),) {
 458             my $symbol = $1;
 459             if ($symbol eq 'gzFile' || $symbol eq 'uInt' || $symbol =~ /^(?:de|in)flate[A-Z]/) {
 460                 # Whitelist symbols from APIs we use.
 461             } elsif ($symbol =~ /^[gs]et[A-Z]$/) {
 462                 # For now, allow setD(), etc.
 463             } elsif ($symbol =~ /^h(?:File|Read|Write|Pipe|Client)$/ || $symbol eq 'fdwCtrlType' || $symbol eq 'pShutdownSocket') {
 464                 # Platform specific names, allow for now.
 465             } else {
 466                 diagnostic('error', "camelCase identifier '$1' - Xapian coding convention is to use lower case and underscores for variables and functions, and CamelCase for class names", $fullline);
 467             }
 468         }
 469         if ($lineno == 1 && m!^\+!) {
 470             if (m!^/\*\* \@file (\S+)!) {
 471                 my $at_file = $1;
 472                 if (length $fnm == length $at_file ||
 473                     (length $fnm > length $at_file && substr($fnm, -length $at_file - 1, 1) eq '/') &&
 474                     substr($fnm, -length $at_file) eq $at_file) {
 475                     # @file matches
 476                 } else {
 477                     diagnostic('error', "\@file doesn't match filename", $fullline);
 478                 }
 479             } else {
 480                 diagnostic('error', "\@file missing", $fullline);
 481             }
 482         }
 483         if (/^\+.*\b(?:class|struct)\b.*:\s*$/) {
 484             diagnostic('error', "Inheritance list split after ':', should be before", $fullline);
 485         }
 486         # Try to distinguish ternary operator (?:) correctly split after ":" vs
 487         # constructor initialiser list incorrectly split after ":".
 488         my $last_in_ternary = $in_ternary;
 489         $in_ternary = / \?(?: |$)/;
 490         if (!$last_in_ternary && !$in_ternary && /^\+.*\)\s*:\s*$/) {
 491             diagnostic('error', "Constructor initialiser list split after ':', should be before", $fullline);
 492         }
 493         if (m,^\+\s+([-+/%^]|[&|]{2})\s,) {
 494             diagnostic('error', "Expression split before operator '$1', should be after", $fullline);
 495         }
 496         if ($lang eq 'h') {
 497             if (m!^\+\s*#\s*(ifndef|define|endif\s*/[*/])\s+((?:[A-Z]+_INCLUDED)?_?\w+_[Hh]\b)!) {
 498                 my ($type, $guard) = ($1, $2);
 499                 my $expected_guard;
 500                 if (!defined $header_guard_macro) {
 501                     if ($type eq 'ifndef') {
 502                         $header_guard_macro = [$type, $guard];
 503                         my $expected_guard = uc $fnm;
 504                         $expected_guard =~ s![-.]!_!g;
 505                         my $cut;
 506                         if (length($expected_guard) > length($guard) &&
 507                             substr($expected_guard, -length($guard) - 1, 1) eq '/' &&
 508                             substr($expected_guard, -length($guard)) eq $guard) {
 509                             $cut = -1;
 510                         } else {
 511                             for my $i (1 .. length($guard)) {
 512                                 my $ch_e = substr($expected_guard, -$i, 1);
 513                                 my $ch_g = substr($guard, -$i, 1);
 514                                 next if ($ch_e eq $ch_g);
 515                                 last if ($ch_e ne '/' || $ch_g ne '_');
 516                                 $cut = $i;
 517                             }
 518                         }
 519                         if (!defined $cut) {
 520                             diagnostic('error', "include guard macro should match filename", $fullline);
 521                         }
 522                         my $prefix = 'XAPIAN_INCLUDED_';
 523                         if ($fnm =~ m!.*omega/(?:.*/)?!) {
 524                             $prefix = 'OMEGA_INCLUDED_';
 525                         }
 526                         #} elsif ($fnm =~ s!.*xapian-core/.*/!!) {
 527                         # $expected_guard = "XAPIAN_INCLUDED_" . $expected_guard;
 528                         #} elsif ($fnm =~ s!.*xapian-letor/.*/!!) {
 529                         #$expected_guard = "XAPIAN_INCLUDED_" . $expected_guard;
 530                         if (defined $cut && $cut == -1) {
 531                             diagnostic('error', "include guard macro should use prefix '$prefix'", $fullline);
 532                         } elsif (defined $cut && substr($guard, 0, length($guard) - $cut + 1) ne $prefix) {
 533                             diagnostic('error', "include guard macro should use prefix '$prefix'", $fullline);
 534                         } elsif ($guard !~ /^\Q$prefix\E/) {
 535                             diagnostic('error', "include guard macro should use prefix '$prefix'", $fullline);
 536                         }
 537                     }
 538                 } else {
 539                     if (!($type eq 'define' && $header_guard_macro->[0] ne 'ifndef')) {
 540                         my $expected_guard = $header_guard_macro->[1];
 541                         $header_guard_macro->[0] = $type;
 542                         if ($guard ne $expected_guard) {
 543                             diagnostic('error', "include guard macro should be $expected_guard", $fullline);
 544                         }
 545                     }
 546                 }
 547             }
 548         } else {
 549             if (m!^\+\s*#\s*define\s+[A-Z]\+_INCLUDED_!) {
 550                 diagnostic('error', "include guard macro defined in non-header", $fullline);
 551             }
 552         }
 553     } elsif (defined $lang && $lang eq 'py') {
 554         if (/^\+.*;\s*$/) {
 555             diagnostic('error', "';' at end of line of python code", $fullline);
 556         }
 557     }
 558     if (defined $fnm && $fnm !~ m!xapian-check-patch|ChangeLog|NEWS|stemming/.*/(?:voc|output)\.txt$!) {
 559         if (/^\+.*?\b(xapain|the the|initialsing|ipv5|outputing)\b/i ||
 560             # Cases which just need to be the prefix of a word
 561             /^\+.*?\b((?:deafult|parm|peform|acessor|comptib|seach|seperat|seprat|separater|iteratat|calulat|delimitor|charactor|databse|operatoar)[a-z]*\b)/i ||
 562             # Case-sensitive cases
 563             /^\+.*?\b(and and)\b/) {
 564             diagnostic('error', "Typo '$1'", $fullline);
 565         }
 566     }
 567
 568     my $first_char = substr($fullline, 0, 1);
 569     if ($first_char eq ' ') {
 570         ++$lineno;
 571     } elsif ($first_char eq '+') {
 572         ++$lineno;
 573         ++$add_lines;
 574     } elsif ($first_char eq '-') {
 575         ++$del_lines;
 576     } elsif ($first_char eq '\\') {
 577         # "\ No newline at end of file" - if preceded by a "+" line, this means
 578         # that the patch leaves the file missing a newline at the end.
 579         if ($last_first_char eq '+') {
 580             diagnostic('error', 'No newline at end of file');
 581         }
 582     }
 583     $last_first_char = $first_char;
 584     $last_line_blank = $line_blank;
 585 }
 586 if (scalar keys %count) {
 587     for (sort keys %count) {
 588         print STDERR "$_ count:\t$count{$_}\n";
 589     }
 590     print STDERR "\n";
 591 }
 592 print STDERR <<"__END__";
 593 Files patched:\t$files
 594 Lines added:\t$add_lines
 595 Lines removed:\t$del_lines
 596 __END__
 597 exit(exists $count{'error'} ? 1 : 0);