#! /usr/bin/perl -w
# Copyright (c) 2007-2020 Olly Betts
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.

require 5.000;
use strict;
use POSIX;

if (defined $ARGV[0] && $ARGV[0] eq '--help') {
    print <<END;
Syntax: $0 [PATCH]...

Nit-pick Xapian patches.

A patch can be supplied on stdin, or one or more patch files listed on the
command line.

Produces output suitable for use with vim's quick-fix mode, and similar
features in other editors.

Example usage:

git diff master.. | xapian-check-patch > tmp.qf
vim -q tmp.qf
END
    exit 0;
}

my ($fnm, $lineno);
my ($last_fullline, $fullline);
my $ext;
my %count;

sub diagnostic_ {
    my ($type, $msg, $n, $l) = @_;
    print "$fnm:$n: $type: $msg";
    if (defined $l) {
	print ": $l";
    } else {
	print "\n";
    }
    ++$count{$type};
}

# Report a diagnostic in the current line.
sub diagnostic {
    my ($type, $msg) = @_;
    diagnostic_($type, $msg, $lineno, $fullline);
}

# Report a diagnostic in the previous line.
sub diagnostic_last {
    my ($type, $msg) = @_;
    diagnostic_($type, $msg, $lineno - 1, $last_fullline);
}

sub count_columns {
    my $s = shift;
    my $len = 0;
    for my $i (0 .. length($s) - 1) {
	if (substr($s, $i, 1) eq "\t") {
	    # Advance to next multiple of 8 column.
	    $len = $len + (8 - $len % 8);
	} else {
	    ++$len;
	}
    }
    return $len;
}

sub check_comment_content {
    local $_ = shift;
    if (/\\([abcefp]|brief|code|deprecated|endcode|exception|file|internal|li|param|private|return|todo)\b/) {
	diagnostic('error', "Doxygen command '\\$1' introduced by '\\' not '\@'");
    }
    if (/\@\s+([abcefp]|brief|code|deprecated|endcode|exception|file|internal|li|param|private|return|todo)\b/) {
	diagnostic('error', "Broken Doxygen command: whitespace between '\@' and '$1'");
    }
    if (/(\@[a-z]+)\s+\1\b/) {
	diagnostic('error', "Double Doxygen command: '$1 $1'");
    }
}

my $add_lines = 0;
my $del_lines = 0;
my $files = 0;
# SVN property changes don't have an "Index: [...]" line.
my $want_tabs = -1;
my $check_indent = 0;
my $check_trailing = 0;
my $check_space_tab = 0;
my $check_end_new_line = 0;
my $in_comment = 0;
my $lang;
my $header_guard_macro;
my $last_first_char = '';
my $in_ternary;
my $preproc;
my $preproc_continuation;
my ($top_level, $next_top_level); # undef for unknown, 0 for no, 1 for yes.
my $last_line_blank = 0;
my $last_line_block_start;
my $last_line_block_end;
my $penultimate_line_block_start;
# Indent in columns expected for this line (undef if we don't know).
my $indent;
# True if the indent increased due to a "case" or "default" without a { - this
# means that a following "case"/"default" should not be indented.
my $case_no_brace;
# Current file is a C/C++ header file.
my $header;
# First line number for doxygen @file comment check.
my $doxygen_first_line;
while (<>) {
    if (defined $next_top_level) {
	$top_level = $next_top_level;
	$next_top_level = undef;
    }

    if (/^Index: (.+)/ || m!^diff --git a/.+ b/(.+)! || m!^\+\+\+ (\S+)!) {
	++$files;
	$fnm = $1;
	(($ext) = ($fnm =~ /\.([\w.]+)$/)) or $ext = '';
	$lineno = 1;
	$lang = undef;
	$in_comment = 0;
	$header_guard_macro = undef;
	$in_ternary = 0;
	$preproc = 0;
	$preproc_continuation = 0;
	$top_level = undef;
	$header = 0;
	# Don't know!
	$want_tabs = -1;
	$check_indent = 0;
	$check_space_tab = 1;
	$check_trailing = 1;
	$doxygen_first_line = 1;
	$check_end_new_line = 1;
	if ($fnm =~ m!xapian-applications/omega/testfiles!) {
	    $check_space_tab = 0;
	    $check_trailing = 0;
	    $doxygen_first_line = 0;
	    $check_end_new_line = 0;
	} elsif ($ext eq 'cc') {
	    if ($fnm =~ m!\b(?:cdb|portability/mkdtemp)! ||
		$fnm =~ m!\bcommon/getopt\.cc$! ||
		$fnm =~ m!\bomega/md5\.cc$! ||
		$fnm =~ m!\bcommon/msvc_dirent\.cc$!) {
		$check_trailing = 0;
	    } else {
		$lang = 'c++';
		$want_tabs = 1 unless ($fnm =~ m!\blanguages/steminternal\.cc$!);
		$check_indent = 1;
	    }
	} elsif ($ext eq 'c') {
	    if ($fnm =~ m!\blanguages/compiler/! ||
		$fnm =~ m!/lemon\.c$!) {
		$check_trailing = 0;
	    } else {
		$lang = 'c';
		$want_tabs = 1;
		$check_indent = 1;
	    }
	} elsif ($ext eq 'h') {
	    if ($fnm =~ m!\binclude/xapian/intrusive_ptr\.h! ||
		$fnm =~ m!\blanguages/compiler/! ||
		$fnm =~ m!\bcommon/msvc_dirent\.h$! ||
		$fnm =~ m!\bcommon/heap\.h$! ||
		$fnm =~ m!/omega/cdb! ||
		$fnm =~ m!\bportability/mkdtemp!) {
		$check_trailing = 0;
	    } else {
		$header = 1;
		$lang = 'c++';
		$want_tabs = 1;
		$check_indent = 1;
	    }
	} elsif ($ext eq 'lemony') {
	    $lang = 'c++';
	    $want_tabs = 1;
	} elsif ($ext eq 'lt') {
	    $want_tabs = 0;
	    $check_trailing = 0;
	} elsif ($ext eq 'py' || $ext eq 'py.in') {
	    $lang = 'py';
	    $want_tabs = 0;
	} elsif ($ext eq 'rb') {
	    $lang = 'rb';
	    $want_tabs = 0;
	} elsif ($ext eq 'sbl') {
	    $check_space_tab = 0;
	    $check_trailing = 0;
	} elsif ($ext eq 'patch') {
	    $check_space_tab = 0;
	} elsif ($ext eq 'txt') {
	    # Imported text file with trailing whitespace.
	    if ($fnm =~ m!/testdata/etext\.txt$!) {
		$check_trailing = 0;
	    }
	} elsif ($fnm =~ m!(?:^|/)Makefile!) {
	    $lang = 'make';
	    $want_tabs = 1;
	} elsif ($fnm =~ m!(?:^|/)ChangeLog\b!) {
	    $lang = 'changelog';
	    $want_tabs = 1;
	}
	# print STDERR "$fnm: lang=" . ($lang // "UNKNOWN") . "\;
	next;
    }
    my $pre3 = substr($_, 0, 3);
    if ($pre3 eq '@@ ') {
	/^\@\@ -\d+,\d+ \+(\d+),\d+\b/ and $lineno = $1;
	$next_top_level = ($lineno == 1) ? 1 : undef;
	$in_comment = ($lineno == 1) ? 0 : undef;
	$last_line_blank = 0;
	$last_line_block_start = undef;
	$last_line_block_end = undef;
	$penultimate_line_block_start = undef;
	$indent = undef;
	$last_first_char = '';
	$last_fullline = undef;
	next;
    }
    if ($pre3 eq '---' || $pre3 eq '+++') {
	next;
    }

    if (!/^.\s*$/) {
	$next_top_level = (/^.\s/ ? 0 : 1);
    }

    my $line_blank = /^[+ ]\s*$/;

    $fullline = $_;
    my $first_char = substr($fullline, 0, 1);

    if (defined $lang && ($lang eq 'c++' || $lang eq 'c')) {
	if (!defined $in_comment) {
	    # Decide if we're in a C-style comment for the first line of a hunk.
	    $in_comment = /^.\s*\*+\s/;
	}
	if ($lineno == $doxygen_first_line && m!^\+!) {
	    if ($doxygen_first_line == 1 && m,^\+%include\b\s*\{,) {
		# If the first line is %include{... check the second.
		$doxygen_first_line = 2;
	    } elsif (m!^\+/\*\*\s+\@file\s*(.*)!) {
		if (length($1)) {
		    diagnostic('error', "Doxygen \@file should not list explicit filename");
		}
	    } elsif ($fnm =~ m!\bomega/md5\.h$!) {
		# Imported file.
	    } else {
		diagnostic('error', "Doxygen \@file missing");
	    }
	}

	# Uncomment commented out parameter names: foo(int /*bar*/) -> foo(int bar)
	s!/\*([A-Za-z_][A-Za-z_0-9]*)\*/([,)])!$1$2!g;

	# Check for comments without a space before the comment text.
	if (m!^\+.*\s/([*/]{1,2})[A-Za-z0-9]!) {
	    if ($ext eq 'lemony' && $1 eq '*' && $' =~ m!^\w*-overwrites-\w+\*/!) {
		# Magic comment in lemon grammar - lemon requires no spaces.
	    } else {
		diagnostic('error', "Missing space between comment characters and comment text");
	    }
	}

	# Trim comments:
	if (!$in_comment) {
	    if (s! /\*(.*?)\*/ ! !g) {
		# C-style comment with spaces around, e.g.
		# { T = P->as_phrase_query(); /*T-overwrites-P*/ }
		if ($first_char eq '+') {
		    check_comment_content($1);
		}
		s/\s+$//;
	    }
	    if (s!/\*(.*?)\*/!!g) {
		# C-style comment without spaces on both sides, e.g.:
		#    foo(); /* blah blah */
		if ($first_char eq '+') {
		    check_comment_content($1);
		}
		s/\s+$//;
	    }
	    if (s!//(.*)!!) {
		# Single line comment, e.g.:
		#    // blah blah
		if ($first_char eq '+') {
		    check_comment_content($1);
		}
		s/\s+$//;
	    }
	    # Take care to avoid interpreting "foo/*" as a comment start.
	    if (s!^.(?:[^"]+?|"(?:[^\\"]*?|\\.)*?")*?/\*(.*)!!g) {
		if ($first_char eq '+') {
		    check_comment_content($1);
		}
		s/\s+$//;
		$in_comment = 1;
	    }
	} else {
	    if (s!^.\s*\*+(.*)\*/!$first_char!) {
		# End of multiline comment with leading *, e.g.:
		#    *  blah blah */
		if ($first_char eq '+') {
		    check_comment_content($1);
		}
		s/\s+$//;
		$in_comment = 0;
	    } elsif (s!^.(.*)\*/!$first_char!) {
		# End of multiline comment without leading *, e.g.:
		#     blah blah */
		if ($first_char eq '+') {
		    check_comment_content($1);
		}
		$in_comment = 0;
	    } else {
		if ($first_char eq '+') {
		    if (m!^.\s*\*+(.*)!) {
			# In multiline comment with leading *.
			check_comment_content($1);
		    } else {
			# In multiline comment without leading *.
			check_comment_content(substr($_, 1));
		    }
		}
		$_ = $first_char;
	    }
	}
    } elsif (defined $lang && $lang eq 'py') {
	# Trim comments:
	if (s!#.*!!g) {
	    s/\s+$//;
	}
    } elsif (defined $lang && $lang eq 'rb') {
	# Trim comments:
	if (s!#.*!!g) {
	    s/\s+$//;
	}
    }

    # Default to not being in a comment for languages other than C/C++.
    $in_comment //= 0;

    # Replace multiple spaces before line continuation marker:
    s!  +\\$! \\!;

    if (defined $lang && ($lang eq 'c++' || $lang eq 'c')) {
	if ($first_char eq '+') {
	    my $expandedline = '';
	    for my $i (1..length($fullline) - 1) {
		my $ch = substr($fullline, $i, 1);
		if ($ch eq "\t") {
		    $expandedline .= ('.' x (8 - length($expandedline) % 8));
		} else {
		    $expandedline .= $ch;
		}
	    }
	    chomp($expandedline);
	    if (length($expandedline) > 80 &&
		# Logging annotations aren't really for human eyes.
		!/^\+[ \t]*LOGCALL/ &&
		# Allow length up to 84 if " in first column for formatting
		# text blocks (the extra 4 being "\n").
		(length($expandedline) > 84 || !/^\+"/) &&
		# Allow longer copyright lines.
		$fullline !~ m,^\+[ /]\* Copyright , &&
		# Allow long initialisers (e.g. for testcases).
		! /^\+\s*\{.*\},?$/ &&
		# Don't force wrapping of a long #error message.
		!/^\+#\d*(error|warning)\b/) {
		diagnostic('error', "Line extends beyond column 80 (to column ".length($expandedline).")");
	    }
	}
	if (m,^\+\s+LOGCALL(?:_[A-Z0-9]+)*\([^"]*"[^"]*(?<!operator)\(,) {
	    diagnostic('error', "Don't include parentheses in debug logging method/class name");
	}
	if (/^\+\s+LOGCALL(?:_[A-Z0-9]+)*\(.*,$/) {
	    diagnostic('error', "Don't wrap long LOGCALL lines");
	}
	if (/^\+\s+(LOGCALL(?:_STATIC)?)\([^,]*,\s*void,$/) {
	    diagnostic('error', "Use $1_VOID for a method with a void return type");
	}
	# Replace string literals containing escaped quotes:
	if (/['"]/) {
	    my $quote = substr($_, $-[0], 1);
	    my $start = $+[0];
	    my $i = $start;
	    my $esc = 0;
QUOTELOOP:  while (1) {
		if ($i >= length($_)) {
		    $_ = substr($_, 0, $start) . "X\n";
		    last;
		}
		my $c = substr($_, $i, 1);
		if ($c eq $quote) {
		    $_ = substr($_, 0, $start) . "X" . substr($_, $i);
		    $i = $start + 2;
		    # See if there's another string after this one:
		    while ($i != length($_)) {
			$c = substr($_, $i, 1);
			++$i;
			if ($c eq '"' || $c eq "'") {
			    $quote = $c;
			    $start = $i;
			    $esc = 0;
			    next QUOTELOOP;
			}
		    }
		    last;
		}
		if ($c eq '\\') {
		    ++$i;
		    $c = substr($_, $i, 1);
		    if ($c eq 'x') {
			++$i while (substr($_, $i, 1) =~ /^[A-Fa-f0-9]$/);
			next;
		    } elsif ($c =~ /^[0-7]/) {
			my $j = $i;
			++$i while ($i - $j <= 3 && substr($_, $i, 1) =~ /^[0-7]$/);
			next;
		    } elsif ($c eq '"' || $c eq "'") {
			++$esc;
		    }
		}
		++$i;
	    }
	}
    }

    if ($check_trailing && $fullline =~ /^\+.*[ \t]$/) {
	diagnostic('error', "added/changed line has trailing whitespace");
    }
    if ($check_space_tab && /^\+.* \t/) {
	diagnostic('error', "added/changed line has space before tab");
    }
    if ($want_tabs == 1 and /^\+\t* {8}/) {
	diagnostic('error', "added/changed line uses spaces for indentation rather than tab");
    }
    if (!$want_tabs and /^\+ *\t/) {
	diagnostic('error', "added/changed line uses tab for indentation rather than spaces");
    }
    if ((!defined $lang || $lang ne 'changelog') && $fullline =~ /^([-+]).*\bFIX(?:ME)\b/) {
	# Break up the string in the regexp above and messages below to avoid
	# this triggering on its own code!
	if ($1 eq '-') {
	    # Not an error, but interesting information.
	    diagnostic('info', "FIX"."ME removed");
	} else {
	    # Not an error, but not good.
	    diagnostic('warning', "FIX"."ME added");
	}
    }
    if (defined $lang && ($lang eq 'c++' || $lang eq 'c')) {
	if ($last_line_blank) {
	    if ($line_blank) {
		# Allow multiple blank lines at the top level for now.
		diagnostic('error', "Extra blank line") unless ($top_level // 1);
	    } elsif (/^.\s+\}$/) {
		# Closing } of a namespace often has a blank line before it,
		# and that seems reasonable.
		diagnostic_last('error', "Blank line at end of block") unless ($top_level // 1);
	    } elsif ($penultimate_line_block_start && /^.(\s|\}$)/) {
		diagnostic_last('error', "Blank line at start of block");
	    }
	}

	if (/^([-+ ])(\s*)\#/) {
	    # Avoid misfiring for something like:
	    # #define FOO(x) \
	    #     #x
	    if (!$preproc_continuation) {
		if ($1 eq '+' && $2 ne '') {
		    diagnostic('error', "Whitespace before '#' on preprocessor line");
		}
	    }
	    $preproc = 1;
	    $preproc_continuation = /\\$/;
	} elsif ($preproc_continuation) {
	    $preproc_continuation = /\\$/;
	} else {
	    $preproc = 0;
	}
	if ($check_space_tab && /^\+( (?:|  |    |      ))[^ \t].*(?:[^)];|[^);,])\n/) {
	    # We only check for 1, 3, 5 and 7 space indents to avoid false
	    # positives for "public:", etc and for wrapped expressions.
	    #
	    # Exclude lines ending ');', ')', or ',' to avoid reporting for
	    # wrapped function arguments.  This means we'll also miss some
	    # cases we should complain about, but it's likely that at least
	    # one line in a mis-indented block will trigger an error.

	    # Exclude potential comment continuation lines which might have
	    # been missed by the comment stripping code.  Require whitespace
	    # after so we flag a mis-indented: *ptr = foo;
	    if (!/^\+\s*\*\s/) {
		diagnostic('error', "line indented by ".length($1)." spaces");
	    }
	}

	#if (/^\+.*(?<!\btypedef )\b([A-Za-z_][A-Za-z_0-9]*)\s+\(/ &&
	if (/^\+.*\b([A-Za-z_][A-Za-z_0-9]*)\s+\(((?:[A-Za-z][A-Za-z0-9_]*::)?\*|[A-Za-z][A-Za-z0-9_]*\)\()?/) {
	    my $name = $1;
	    my $post = $2;
	    if (
		# `delete (*i)->foo();` rather than `delete(*i)->foo()'` - the `(`
		# isn't around function parameters here.
		$name !~ /^(case|catch|delete|double|for|if|return|switch|throw|while)$/ &&
		# Function pointer type `int (*)(void)` or parenthesised
		# function name `int (foo)(`.
		!($name =~ /^(?:bool|double|float|unsigned|void|[a-z][a-z0-9_]+_t|(?:(?:un)?signed\s+)?(?:char|int|long|short))$/ && length($post))) {
		if (!$preproc) {
		    diagnostic('error', "Whitespace between '$name' and '('");
		} else {
		    # FIXME: We skip preprocessor lines for now to avoid triggering
		    # on things like «#define FOUR (4)» but it would be good to
		    # catch «#define FOO(x) foo (x)»
		}
	    }
	}
	if (m!^\+\s*(case|class|do|for|if|namespace|struct|switch|try|union)\b([^ ]| \s)!) {
	    diagnostic('error', "'$1' not followed by exactly one space");
	}
	if (m!^\+.*;[^\s\\]!) {
	    diagnostic('error', "Missing space after ';'");
	}
	if (m!^\+.*[^(;]\s;!) {
	    # Stuff like this is OK: for ( ; ; ) {
	    # though for that exact case I'd suggest: while (true) {
	    diagnostic('error', "Whitespace before ';'");
	}
	if (m!^\+.*?<<"!) {
	    diagnostic('error', "Missing space after '<<'");
	}
	if (m!^\+.*?"<<!) {
	    diagnostic('error', "Missing space before '<<'");
	}
	if (m!^\+.*?\b(return)\b([^ ;]| \s)!) {
	    diagnostic('error', "'$1' not followed by exactly one space");
	}
	if (m!^\+.*?\b(else)\b([^ \n]| \s)!) {
	    diagnostic('error', "'$1' not followed by exactly one space");
	}
	if (m!^\+.*?\b(catch|while)\b([^ ]| \s)!) {
	    diagnostic('error', "'$1' not followed by exactly one space");
	}
	if (m!^\+.*?(?:}|}\s{2,}|}\t|^[^}]*)\b(catch)\b!) {
	    diagnostic('error', "'$1' not preceded by exactly '} '");
	}
	if (m!^\+.*?(?:}|}\s{2,}|}\t)\b(else|while)\b!) {
	    diagnostic('error', "'}' and '$1' not separated by exactly one space");
	}
	if (m,^\+.*?\belse\b\s*(?!if)[^\s{],) {
	    diagnostic('error', "Code after 'else' on same line");
	}
	if (m,^\+.*?\belse\s+if.*;\s*$,) {
	    diagnostic('error', "Code after 'else if' on same line");
	}
	if (m!^\+.*\((?: [^;]|\t)!) {
	    # Allow: for ( ; i != 10; ++i)
	    diagnostic('error', "Whitespace after '('");
	}
	if (m!^\+.*\H.*\h\)!) {
	    diagnostic('error', "Whitespace before ')'");
	}
	if (m!^\+.*;\s*(\w+)([-+]{2})\)!) {
	    diagnostic('error', "Prefer '$2$1' to '$1$2'");
	}
	if (m!^\+.*?>\s+>!) {
	    diagnostic('error', "We assume C++11 so can write '>>' instead of '> >'");
	}
	if (m!^\+.*?\b(?:enable_if|list|map|multimap|multiset|priority_queue|set|template|unordered_map|unordered_set|vector)\s+<!) {
	    diagnostic('error', "Whitespace between template name and '<'");
	}
	if (/^\+.*?\bfor\s*\([^(]*([^:(]:[^:])/ && $1 ne ' : ') {
	    diagnostic('error', "Missing spaces around ':' in 'for'");
	}
	if (m,^\+.*?[\w)](?!-[->]|\+\+)((?:\&\&|\|\||<<|>>|[-+/*%~=<>!&|^])=?|[?]),) {
	    my @pre = @-;
	    my @post = @+;
	    my $op = $1;
	    if (substr($_, $pre[1] - 8, 8) eq 'operator') {
		# operator*() etc
	    } elsif ($op eq '>' && substr($_, 0, $pre[1]) =~ /[A-Za-z0-9_]</) {
		# y = static_cast<char>(x);
	    } elsif ($op eq '>') {
	    } elsif ($op eq '<' && substr($_, $pre[1] - 1, 1) =~ /^[A-Za-z0-9_]$/ && substr($_, $post[1]) =~ />/) {
		# y = static_cast<char>(x);
	    } elsif ($op eq '<' &&
		     substr($_, 0, $pre[1]) =~ /\b(?:enable_if|list|map|multimap|multiset|priority_queue|set|template|unordered_map|unordered_set|vector)$/) {
		# y = priority_queue<Foo*,
		#                    Bar>;
		# template<typename A,
		#          typename B>
	    } elsif ($op eq '&&' && substr($_, 0, $pre[1]) =~ /\b(?:auto|bool|char|double|float|int(?:\d+_t)?|long|short|string|uint\d+_t|unsigned|void|[A-Z][A-Za-z0-9_]*)$/) {
		# auto&& x;
		# method(Class&& foo);
	    } elsif (($op eq '<<' || $op eq '>>') &&
		substr($_, 0, $pre[1]) =~ /\b(?:0x[0-9a-fA-F]+|[0-9]+)$/ &&
		substr($_, $post[1]) =~ /^(?:0x[0-9a-fA-F]+|[0-9]+)\b/) {
		# 0x00b1<<26
	    } elsif (($op eq '-' || $op eq '+') &&
		substr($_, 0, $pre[1]) =~ /[0-9]\.?e$/) {
		# 1.2e-3, 7.e+3
	    } elsif ($op eq '>>' &&
		/[A-Za-z0-9_]<.+</) {
		# vector<vector<int>> v;
	    } elsif ($op =~ /^[*&|]$/ &&
		     substr($_, 0, $pre[1]) !~ /(?:\b\d+)\s*$/) {
		# FIXME: *: const char* x;
		# FIXME: &: const char& x;
		# FIXME: |: FOO|BAR
		# (but we do catch "1234*x"
	    } elsif ($preproc && /^.\s*#\s*(?:include|error|warning)\b/) {
		# Don't warn about missing whitespace in:
		# #include <a/b-c.h>
		# #error nothing works!
	    } else {
		diagnostic('error', "Missing space before '$op'");
	    }
	}
	if ($first_char eq '+' && length($_)) {
	    # Replace leading `+` to avoid parsing as an operator or part of an
	    # operator.
	    my $l = ' ' . substr($_, 1);
	    # Treat some operator combinations as a single pseudo-operator:
	    # x &=~ y;
	    # a = b &~ c;
	    while ($l =~ m@((?:\|\||<<|>>|[=!/*%<>|^~])=?|-[-=>]?|&[&=]?~?|\+[\+=]?|::?|[?,])@g) {
		my @pre = @-;
		my @post = @+;
		my $op = $1;
		my $prech = substr($l, $pre[1] - 1, 1);
		my $postch = substr($l, $post[1], 1) // '';
		if ($lang eq 'c++' &&
		    ($op eq '*' || $op eq '&') &&
		    (
		     # `vector<some_type *> x;` `int f(some_type *);`
		     (($postch eq '>' || $postch eq ')') && $prech =~ /[ \t]/) ||
		     # `vector<int>*` `string&` `const foo*` `struct tm*` `Xapian::docid&`
		     # +static_assert(Xapian::DB_READONLY_ & Xapian::DB_NO_TERMLIST,
		     (
		      substr($l, 0, $pre[1]) =~ /(?:>|\b(?:auto|bool|char|const|double|float|int(?:\d+_t)?|long|short|string|uint\d+_t|unsigned|void|DIR|DWORD|FD|FILE|HANDLE|WSAOVERLAPPED|[A-Z][A-Z_]*_T|[A-Z]|[A-Z][A-Z0-9_]*?[a-z][A-Za-z0-9_]*|size_type|(?:(?:const|struct)\s+?|Xapian::)[A-Z]*[a-z][A-Za-z0-9_]*)[*&]*)\s+$/ &&
		      substr($l, $post[1]) !~ /^\s*\(/
		     )
		    )
		   ) {
		    diagnostic('error', "Preferred style is 'int$op x' (not 'int ${op}x' or 'int ${op} x')");
		} elsif ($op eq '::') {
		    if ($lang eq 'c++' && $postch =~ /\s/) {
			diagnostic('error', "Whitespace not expected after '::'");
		    }
		} elsif ($op eq '->' && $prech !~ /\s/) {
		    # a->b
		    # but not:
		    # auto f() -> bool
		    if ($postch =~ /[ \t]/) {
			diagnostic('error', "Whitespace not expected after '->'");
		    }
		} elsif (($op eq '++' || $op eq '--') && $prech !~ /[A-Za-z0-9_)]/) {
		    # ++a
		    if ($postch =~ /[ \t]/) {
			diagnostic('error', "Whitespace not expected after '$op'");
		    }
		} elsif ($op eq '!') {
		    # !a
		    if ($postch =~ /[ \t]/) {
			diagnostic('error', "Whitespace not expected after '!'");
		    }
		} elsif (substr($l, $post[1]) !~ /^(?:\S| \s)/) {
		    # Check what follows the operator.
		} elsif (($op eq '++' || $op eq '--') && $postch =~ /[\]),;]/) {
		    # buf[len++] = 'a';
		    # f(x++);
		    # f(1, x++);
		    # a = b++;
		} elsif (($op eq '-' || $op eq '+' || $op eq '!' || $op eq '~') &&
		    substr($l, 0, $pre[1]) =~ m@(?:^\s*|[-+/*%~=<>&|,;?:] |[\[(]|\b(?:return|case) |^\+\s*)$@) {
		    # Unary -, +, !, ~: e.g. foo = +1; bar = x * (-y); baz = a * -b;
		} elsif ($op eq ',' && (
		    /\b(?:AssertRel(?:Paranoid)?|TEST_REL)\(/ ||
		    /{[^()]*}/)) {
		    # AssertRel(a,<,b);
		} elsif ($op eq '>>' &&
		    /[A-Za-z0-9_]<.+</) {
		    # vector<vector<int>>&
		} elsif ($op eq '*' &&
			 substr($l, 0, $pre[1]) !~ /(?:\b\d+)\s*$/ &&
			 !($lang eq 'c++' &&
			   substr($l, 0, $pre[1]) =~ /(?:>|\b(?:auto|bool|char|const|double|float|int(?:\d+_t)?|long|short|string|uint\d+_t|unsigned|void|[A-Z][A-Za-z0-9_]*|(?:struct\s*?|Xapian::)[a-z][a-z0-9_]*)[*&]*)\s+$/)) {
		    # FIXME: *ptr (dereference)
		    # (but we do catch "1234 *x" and common pointer types etc)
		} elsif ($op eq '&' &&
			 substr($l, 0, $pre[1]) !~ /(?:\b\d+|[^*]\))\s*$/ &&
			 !($lang eq 'c++' &&
			   substr($l, 0, $pre[1]) =~ /(?:>|\b(?:auto|bool|char|const|double|float|int(?:\d+_t)?|long|short|string|uint\d+_t|unsigned|void|[A-Z][A-Za-z0-9_]*|(?:struct\s*?|Xapian::)[a-z][a-z0-9_]*)[*&]*)\s+$/)) {
		    # FIXME: &foo (address of)
		    # (but we do catch "...) &FLAG_FOO" and "1234 &x" and common reference types etc)
		} elsif ($op eq '&&' && $postch =~ /[,)]/) {
		    # int f(int&&, bool&&);
		} elsif ($op =~ /^[<|]$/ &&
			 substr($l, $post[1]) !~ /^\s*(?:\d+\b|\()/ &&
			 substr($l, 0, $pre[1]) !~ /(?:\b\d+|\))\s*$/) {
		    # FIXME: <: std::vector<std::string>
		    # (but we do catch "...) <foo" and "1234 >bar" etc)
		    # FIXME: |: FOO|BAR
		} elsif (substr($l, $pre[1] - 8, 8) eq 'operator' && $postch eq '(') {
		    # operator==() etc
		} elsif (($op eq '<<' || $op eq '>>') &&
		    substr($l, 0, $pre[1]) =~ /\b(?:0x[0-9a-fA-F]+|[0-9]+)$/ &&
		    substr($l, $post[1]) =~ /^(?:0x[0-9a-fA-F]+|[0-9]+)\b/) {
		    # 0x00b1<<26
		} elsif (($op eq '-' || $op eq '+') &&
		    substr($l, 0, $pre[1]) =~ /[0-9]\.?e$/) {
		    # 1.2e-3, 7.e+3
		} elsif ($preproc && $op eq ',') {
		    # Currently there's a lot of: #define FOO(A,B) ...
		} elsif ($preproc && /^.\s*#\s*(?:include|error|warning|pragma)\b/) {
		    # Don't warn about missing whitespace in:
		    # #include <a/b-c.h>
		    # #warning so-so
		    # #pragma warning(disable:4146)
		} elsif ($op eq '>' && ($postch =~ /[,)(;*&\\]/ || substr($l, $post[1], 2) eq '::')) {
		    # int f(vector<int>, vector<int>);
		    # static_cast<char>(7)
		    # return tmpl<true>;
		    # vector<int>* x;
		    # vector<int>& y;
		    # template<class S>\
		    # vector<int>::size_type
		} elsif ($op eq '=' && $postch =~ /[,\]]/) {
		    # Lambdas, e.g. [=]() {...} or [=, &a]() {...}
		} elsif ($op eq '%' && $ext eq 'lemony' && $pre[1] == 1) {
		    # %-directive in Lemon grammar, e.g.:
		    # %left OR.
		} elsif ($op =~ /^([<>]|[<>=!]=)$/ && substr($l, 0, $pre[1]) =~ /\b(?:AssertRel(?:Paranoid)?|TEST_REL)\(/) {
		    # AssertRel(a,>=,b);
		    # TEST_REL(a,>=,b);
		} elsif ($op eq '~' && $postch =~ /[A-Za-z0-9_]/ && substr($l, 0, $pre[1]) =~ /(?:\s|::)$/) {
		    # ~Foo()
		    # Foo::~Foo()
		} else {
		    # Don't complain about this if it's actually whitespace at
		    # line end.
		    if (substr($l, $post[1]) !~ /^\s*$/) {
			diagnostic('error', "Should have exactly one space after '$op'");
		    }
		}
	    }
	}
	if (/^\+.*;;\s*$/) {
	    diagnostic('error', "Extra ';' at end of line");
	}
	if (/^\+\s*?\S.*? (,|->)/) {
	    diagnostic('error', "Space before '$1'");
	}
	if (/^\+[\s#]*?[^\s#]  /) {
	    # Allow multiple spaces in "#  ifdef FOO".
	    diagnostic('error', "Multiple spaces");
	}
	if (/^\+\s*#\s*include([<"])/) {
	    # #include<foo.h> or #include"foo.h"
	    diagnostic('error', "Missing space between #include and '$1'");
	}
	if (m!^\+(?:.*[;{])?\s*/[/*]{1,2}\w!) {
	    diagnostic('error', "added/changed line has comment without whitespace before the text");
	}
	if (m!^\+.*?\)\{!) {
	    diagnostic('error', "No space between ')' and '{'");
	}
	if (m!^\+.*?\bconst\{!) {
	    diagnostic('error', "No space between 'const' and '{'");
	}
	if ($fnm !~ m!/(?:md5|posixy_wrapper|perftest)\.cc$! &&
	    m,^\+.*[^\w\.>]([a-z][a-z0-9]*[A-Z]\w*),) {
	    my $symbol = $1;
	    my $symbol_idx = $-[1];
	    if ($ext eq 'lemony' && $symbol =~ /^yy/) {
		# Used in lemon parser grammar.
	    } elsif ($symbol =~ /^[gs]et[A-Z]$/) {
		# For now, allow setD(), etc.
	    } elsif ($symbol =~ /^h(?:File|Read|Write|Pipe|Client)$/ || $symbol eq 'fdwCtrlType' || $symbol eq 'pShutdownSocket') {
		# Platform specific names, allow for now.
	    } elsif ($symbol eq 'gzFile' || $symbol eq 'uInt' || $symbol =~ /^(?:de|in)flate[A-Z]/) {
		# zlib API uses camelCase names.
	    } elsif ($symbol =~ /^pix[A-Z]/) {
		# Tesseract's leptonica image library uses camelCase names.
	    } elsif (substr($_, 0, $symbol_idx) =~ /\bicu::(\w+::)?$/) {
		# ICU library namespace uses camelCase method names.
	    } elsif (substr($_, 0, $symbol_idx) =~ /\b(?:EBOOK|Etonyek|RVNG)\w+::$/) {
		# Libe-book/libetonyek/librevenge use camelCase method names.
	    } else {
		diagnostic('error', "camelCase identifier '$symbol' - Xapian coding convention is to use lower case and underscores for variables and functions, and CamelCase for class names");
	    }
	}
	if (/^\+.*\b(?:class|struct)\b.*:\s*$/) {
	    diagnostic('error', "Inheritance list split after ':', should be before");
	}
	# Try to distinguish ternary operator (?:) correctly split after ":" vs
	# constructor initialiser list incorrectly split after ":".
	my $last_in_ternary = $in_ternary;
	$in_ternary = / \?(?: |$)/;
	if (!$last_in_ternary && !$in_ternary && /^\+.*\)\s*:\s*$/) {
	    diagnostic('error', "Constructor initialiser list split after ':', should be before");
	}
	if (m,^\+\s+([-+/%^]|[&|]{2})\s,) {
	    diagnostic('error', "Expression split before operator '$1', should be after");
	}
	if ($lang eq 'c++' && /^\+\s+inline\b/) {
	    diagnostic('error', "Method defined inside a class is implicitly 'inline'");
	}
	if ($header) {
	    if (/^\+using\s+namespace\b/) {
		diagnostic('error', "Avoid 'using namespace' at top level of header");
	    }
	    if (m!^\+\s*#\s*(ifndef|define|endif\s*/[*/])\s+((?:[A-Z]+_INCLUDED)?_?\w+_[Hh]\b)!) {
		my ($type, $guard) = ($1, $2);
		my $expected_guard;
		if (!defined $header_guard_macro) {
		    if ($type eq 'ifndef') {
			$header_guard_macro = [$type, $guard];
			my $expected_guard = uc $fnm;
			$expected_guard =~ s![-.]!_!g;
			my $cut;
			if (length($expected_guard) > length($guard) &&
			    substr($expected_guard, -length($guard) - 1, 1) eq '/' &&
			    substr($expected_guard, -length($guard)) eq $guard) {
			    $cut = -1;
			} else {
			    for my $i (1 .. length($guard)) {
				my $ch_e = substr($expected_guard, -$i, 1);
				my $ch_g = substr($guard, -$i, 1);
				next if ($ch_e eq $ch_g);
				last if ($ch_e ne '/' || $ch_g ne '_');
				$cut = $i;
			    }
			}
			if (!defined $cut) {
			    diagnostic('error', "include guard macro should match filename");
			}
			my $prefix = 'XAPIAN_INCLUDED_';
			if ($fnm =~ m!.*omega/(?:.*/)?!) {
			    $prefix = 'OMEGA_INCLUDED_';
			}
			#} elsif ($fnm =~ s!.*xapian-core/.*/!!) {
			# $expected_guard = "XAPIAN_INCLUDED_" . $expected_guard;
			#} elsif ($fnm =~ s!.*xapian-letor/.*/!!) {
			#$expected_guard = "XAPIAN_INCLUDED_" . $expected_guard;
			if (defined $cut && $cut == -1) {
			    diagnostic('error', "include guard macro should use prefix '$prefix'");
			} elsif (defined $cut && substr($guard, 0, length($guard) - $cut + 1) ne $prefix) {
			    diagnostic('error', "include guard macro should use prefix '$prefix'");
			} elsif ($guard !~ /^\Q$prefix\E/) {
			    diagnostic('error', "include guard macro should use prefix '$prefix'");
			}
		    }
		} else {
		    if (!($type eq 'define' && $header_guard_macro->[0] ne 'ifndef')) {
			my $expected_guard = $header_guard_macro->[1];
			$header_guard_macro->[0] = $type;
			if ($guard ne $expected_guard) {
			    diagnostic('error', "include guard macro should be $expected_guard");
			}
		    }
		}
	    }
	} else {
	    if (m!^\+\s*#\s*define\s+[A-Z]\+_INCLUDED_!) {
		diagnostic('error', "include guard macro defined in non-header");
	    }
	}

	if (defined $last_line_block_end &&
	    /^\+${last_line_block_end}(catch|else)\b/) {
	    # FIXME: while in do { ... } while can't be as easily checked.
	    diagnostic('error', "'$1' should be on same line as preceding '}'");
	}
    } elsif (defined $lang && $lang eq 'py') {
	if (/^\+.*;\s*$/) {
	    diagnostic('error', "';' at end of line of python code");
	}
    } elsif (defined $lang && $lang eq 'rb') {
	if (/^\+.*;\s*$/) {
	    diagnostic('error', "';' at end of line of ruby code");
	}
    } elsif (defined $lang && $lang eq 'make') {
	if (/^\+.*[A-Za-z0-9)}]  +\s*$/) {
	    diagnostic('error', "multiple spaces in Makefile");
	}
    }
    if (defined $fnm && $fnm !~ m!xapian-check-patch|ChangeLog|NEWS|stemming/.*/(?:voc2?|output2?)\.txt$|omega/testfiles/|unicode/UnicodeData\.txt!) {
	if ($fullline =~ /^\+.*?(?:\b|_)(xapain|the the|initialsing|ipv5|outputing|intened|wull|extrac|if it possible|betweem|differen|auxiliar|wat(?:|ed|ing|s)|wth|teh|ned|incase)(?:\b|_)/i ||
	    # Cases which just need to be the prefix of a word
	    $fullline =~ /^\+.*?(?:\b|_)((?:deafult|parm|peform|acessor|comptib|seach|seperat|seprat|separater|iteratat|calulat|delimitor|delimeter|charactor|databse|operatoar|implict|differnt|orignal|straterg|unecessar|comamnd|docuemnt|implment|initilias|capatil|reprensent|ommit|openning|openned|appropirate|labrar|returm|interati|termfrequenc|continous|juding|gradinet|clearling|clearled|retreiv|reteriv|filedescriptor|avalil*ab|assessem|contruct|particlar|revelan|releven|relv|intial|eal|specifiy|(?:tera|mega|kilo)?btye|comunic|accumlat|useage|existant|regrex|next(?!step)[eis])[a-z]*(?:\b|_))/i ||
	    # Case-sensitive cases
	    $fullline =~ /^\+.*?\b(and and|dont|Dont)\b/) {
	    diagnostic('error', "Typo '$1'");
	}
    }

    if ($check_indent) {
	# Check indentation.
	if (defined $indent && $first_char eq '+' &&
	    # blank
	    !/^\+\s*$/ &&
	    # Preprocessor line
	    !$preproc &&
	    # Label for goto
	    !/^\+[A-Za-z_][A-Za-z_0-9]*:/ &&
	    # outdent
	    !/^\+\s*}/) {
	    # Special handling for access specifiers, which should get a half indent.
	    if (/^\+\s*(?:private|protected|public):/) {
		$indent -= 2;
	    } elsif ($case_no_brace && /^\+(?:[ \t]*)(?:case\b.*|default):(?:\s*\{)?$/) {
		# case or default following a case or default without a '{', so
		# shouldn't be indented - reduce $indent by 4 columns.
		$indent -= 4;
	    }
	    my $this_indent = 0;
	    if ($fullline =~ /^.([ \t]+)/) {
		$this_indent = count_columns($1);
	    }
	    my $extra = $this_indent - $indent;
	    if ($extra) {
		my $which = 'over';
		if ($extra < 0) {
		    $extra = -$extra;
		    $which = 'under';
		}
		my $s = '';
		$s = 's' if $extra > 1;
		diagnostic('error', "Line ${which}indented by $extra column$s");
	    }
	}

	#if (/^[-+ ]([ \t]*)(?:(?:(?:catch|for|if|for|switch|while)\b.*\)|(?:case|class|do|else|struct|try|union)\b.*) \{|case\b.*:)$/) {
	if (/^[+ ]([ \t]*)(?:(catch|for|if|for|while|case|class|default|do|else|struct|try|union)\b.* \{|(case\b.*|default):)$/) {
	    $indent = count_columns($1);
	    my $keyword = $2 // $3;
	    $case_no_brace = $3;
	    # FIXME: Might be OK in e.g. lambdas
	    #if (/^\+/ && $indent % 4 != 0) {
	    #    diagnostic('error', "Indented by $len columns - not a multiple of 4");
	    #}
	    $indent += $keyword =~ /^(?:case|switch|default)/ ? 2 : 4;
	} elsif (/^[-+ ]([ \t]*)(?:(?:private|protected|public):)$/) {
	    # Access specifiers get a half indent and are followed by another half indent.
	    $indent = count_columns($1);
	    $case_no_brace = undef;
	    if (/^\+/ && $indent % 4 != 2) {
		diagnostic('error', "Indented by $indent columns, should be 2 plus a multiple of 4");
	    }
	    $indent += 2;
	} elsif (!/^.\s*$/) {
	    # Only reset for a non-blank line (after comment removal).
	    $indent = undef;
	    $case_no_brace = undef;
	}
    }

    if ($first_char eq ' ') {
	++$lineno;
    } elsif ($first_char eq '+') {
	++$lineno;
	++$add_lines;
    } elsif ($first_char eq '-') {
	++$del_lines;
    } elsif ($first_char eq '\\') {
	# "\ No newline at end of file" - if preceded by a "+" line, this means
	# that the patch leaves the file missing a newline at the end.
	if ($check_end_new_line && $last_first_char eq '+') {
	    diagnostic_last('error', 'No newline at end of file');
	}
    }
    $last_fullline = $fullline;
    $last_first_char = $first_char;
    $last_line_blank = $line_blank;
    if (/^.([ \t]+)\}$/) {
	$last_line_block_end = $1;
    } else  {
	$last_line_block_end = undef;
    }
    $penultimate_line_block_start = $last_line_block_start;
    if (/^.(.*\{)\s*$/) {
	$last_line_block_start = $1;
    } else {
	$last_line_block_start = undef;
    }
}
if (scalar keys %count) {
    for (sort keys %count) {
	print STDERR "$_ count:\t$count{$_}\n";
    }
    print STDERR "\n";
}
print STDERR <<"__END__";
Files patched:\t$files
Lines added:\t$add_lines
Lines removed:\t$del_lines
__END__

exit 0 unless exists $count{'error'};

if (exists $ENV{GITHUB_JOB} || exists $ENV{TRAVIS}) {
    print STDERR <<"__END__";

You can run these checks locally before pushing with the xapian-check-patch
which is in the source tree in the xapian-maintainer-tools directory.

E.g. to check any changes in your working directory which aren't on master:

git diff master.. | xapian-maintainer-tools/xapian-check-patch
__END__
}

exit 1;
