checkpatch.pl

#!/usr/bin/env perl
# (c) 2001, Dave Jones. (the file handling bit)
# (c) 2005, Joel Schopp <jschopp@austin.ibm.com> (the ugly bit)
# (c) 2007,2008, Andy Whitcroft <apw@uk.ibm.com> (new conditions, test suite)
# (c) 2008-2010 Andy Whitcroft <apw@canonical.com>
# Licensed under the terms of the GNU GPL License version 2

use strict;
use warnings;
use Term::ANSIColor qw(:constants);

my $P = $0;
$P =~ s@.*/@@g;

our $SrcFile    = qr{\.(?:(h|c)(\.inc)?|cpp|s|S|pl|py|sh)$};

my $V = '0.31';

use Getopt::Long qw(:config no_auto_abbrev);

my $quiet = 0;
my $tree = 1;
my $chk_signoff = 1;
my $chk_patch = undef;
my $chk_branch = undef;
my $tst_only;
my $emacs = 0;
my $terse = 0;
my $file = undef;
my $color = "auto";
my $no_warnings = 0;
my $summary = 1;
my $mailback = 0;
my $summary_file = 0;
my $root;
my %debug;
my $help = 0;
my $codespell = 0;
my $codespellfile = "/usr/share/codespell/dictionary.txt";
my $user_codespellfile = "";

sub help {
	my ($exitcode) = @_;

	print << "EOM";
Usage:

    $P [OPTION]... [FILE]...
    $P [OPTION]... [GIT-REV-LIST]

Version: $V

Options:
  -q, --quiet                quiet
  --no-tree                  run without a qemu tree
  --no-signoff               do not check for 'Signed-off-by' line
  --patch                    treat FILE as patchfile
  --branch                   treat args as GIT revision list
  --emacs                    emacs compile window format
  --terse                    one line per report
  -f, --file                 treat FILE as regular source file
  --strict                   fail if only warnings are found
  --root=PATH                PATH to the qemu tree root
  --no-summary               suppress the per-file summary
  --mailback                 only produce a report in case of warnings/errors
  --summary-file             include the filename in summary
  --debug KEY=[0|1]          turn on/off debugging of KEY, where KEY is one of
                             'values', 'possible', 'type', and 'attr' (default
                             is all off)
  --test-only=WORD           report only warnings/errors containing WORD
                             literally
  --codespell                Use the codespell dictionary for spelling/typos
                             (default: $codespellfile)
  --codespellfile            Use this codespell dictionary
  --color[=WHEN]             Use colors 'always', 'never', or only when output
                             is a terminal ('auto'). Default is 'auto'.
  -h, --help, --version      display this help and exit

When FILE is - read standard input.
EOM

	exit($exitcode);
}

# Perl's Getopt::Long allows options to take optional arguments after a space.
# Prevent --color by itself from consuming other arguments
foreach (@ARGV) {
	if ($_ eq "--color" || $_ eq "-color") {
		$_ = "--color=$color";
	}
}

GetOptions(
	'q|quiet+'		=> \$quiet,
	'tree!'			=> \$tree,
	'signoff!'		=> \$chk_signoff,
	'patch!'		=> \$chk_patch,
	'branch!'		=> \$chk_branch,
	'emacs!'		=> \$emacs,
	'terse!'		=> \$terse,
	'f|file!'		=> \$file,
	'strict!'		=> \$no_warnings,
	'root=s'		=> \$root,
	'summary!'		=> \$summary,
	'mailback!'		=> \$mailback,
	'summary-file!'		=> \$summary_file,
	'debug=s'		=> \%debug,
	'test-only=s'		=> \$tst_only,
	'codespell!'		=> \$codespell,
	'codespellfile=s'	=> \$user_codespellfile,
	'color=s'		=> \$color,
	'no-color'		=> sub { $color = 'never'; },
	'h|help'		=> \$help,
	'version'		=> \$help
) or help(1);

if ($user_codespellfile) {
	# Use the user provided codespell file unconditionally
	$codespellfile = $user_codespellfile;
} elsif (!(-f $codespellfile)) {
	# If /usr/share/codespell/dictionary.txt is not present, try to find it
	# under codespell's install directory: <codespell_root>/data/dictionary.txt
	if (($codespell || $help) && which("python3") ne "") {
		my $python_codespell_dict = << "EOF";

import os.path as op
import codespell_lib
codespell_dir = op.dirname(codespell_lib.__file__)
codespell_file = op.join(codespell_dir, 'data', 'dictionary.txt')
print(codespell_file, end='')
EOF

		my $codespell_dict = `python3 -c "$python_codespell_dict" 2> /dev/null`;
		$codespellfile = $codespell_dict if (-f $codespell_dict);
	}
}

help(0) if ($help);

my $exit = 0;

if ($#ARGV < 0) {
	print "$P: no input files\n";
	exit(1);
}

if (!defined $chk_branch && !defined $chk_patch && !defined $file) {
	$chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0;
	$file = $ARGV[0] =~ /$SrcFile/ ? 1 : 0;
	$chk_patch = $chk_branch || $file ? 0 : 1;
} elsif (!defined $chk_branch && !defined $chk_patch) {
	if ($file) {
		$chk_branch = $chk_patch = 0;
	} else {
		$chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0;
		$chk_patch = $chk_branch ? 0 : 1;
	}
} elsif (!defined $chk_branch && !defined $file) {
	if ($chk_patch) {
		$chk_branch = $file = 0;
	} else {
		$chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0;
		$file = $chk_branch ? 0 : 1;
	}
} elsif (!defined $chk_patch && !defined $file) {
	if ($chk_branch) {
		$chk_patch = $file = 0;
	} else {
		$file = $ARGV[0] =~ /$SrcFile/ ? 1 : 0;
		$chk_patch = $file ? 0 : 1;
	}
} elsif (!defined $chk_branch) {
	$chk_branch = $chk_patch || $file ? 0 : 1;
} elsif (!defined $chk_patch) {
	$chk_patch = $chk_branch || $file ? 0 : 1;
} elsif (!defined $file) {
	$file = $chk_patch || $chk_branch ? 0 : 1;
}

if (($chk_patch && $chk_branch) ||
    ($chk_patch && $file) ||
    ($chk_branch && $file)) {
	die "Only one of --file, --branch, --patch is permitted\n";
}
if (!$chk_patch && !$chk_branch && !$file) {
	die "One of --file, --branch, --patch is required\n";
}

if ($color =~ /^always$/i) {
	$color = 1;
} elsif ($color =~ /^never$/i) {
	$color = 0;
} elsif ($color =~ /^auto$/i) {
	$color = (-t STDOUT);
} else {
	die "Invalid color mode: $color\n";
}

my $dbg_values = 0;
my $dbg_possible = 0;
my $dbg_type = 0;
my $dbg_attr = 0;
my $dbg_adv_dcs = 0;
my $dbg_adv_checking = 0;
my $dbg_adv_apw = 0;
for my $key (keys %debug) {
	## no critic
	eval "\${dbg_$key} = '$debug{$key}';";
	die "$@" if ($@);
}

my $rpt_cleaners = 0;

if ($terse) {
	$emacs = 1;
	$quiet++;
}

if ($tree) {
	if (defined $root) {
		if (!top_of_kernel_tree($root)) {
			die "$P: $root: --root does not point at a valid tree\n";
		}
	} else {
		if (top_of_kernel_tree('.')) {
			$root = '.';
		} elsif ($0 =~ m@(.*)/scripts/[^/]*$@ &&
						top_of_kernel_tree($1)) {
			$root = $1;
		}
	}

	if (!defined $root) {
		print "Must be run from the top-level dir. of a qemu tree\n";
		exit(2);
	}
}

my $emitted_corrupt = 0;

our $Ident	= qr{
			[A-Za-z_][A-Za-z\d_]*
			(?:\s*\#\#\s*[A-Za-z_][A-Za-z\d_]*)*
		}x;
our $Storage	= qr{extern|static|asmlinkage};
our $Sparse	= qr{
			__force
		}x;

# Notes to $Attribute:
our $Attribute	= qr{
			const|
			volatile|
			G_NORETURN|
			G_GNUC_WARN_UNUSED_RESULT|
			G_GNUC_NULL_TERMINATED|
			QEMU_PACKED|
			G_GNUC_PRINTF
		  }x;
our $Modifier;
our $Inline	= qr{inline};
our $Member	= qr{->$Ident|\.$Ident|\[[^]]*\]};
our $Lval	= qr{$Ident(?:$Member)*};

our $Constant	= qr{(?:[0-9]+|0x[0-9a-fA-F]+)[UL]*};
our $Assignment	= qr{(?:\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=)};
our $Compare    = qr{<=|>=|==|!=|<|>};
our $Operators	= qr{
			<=|>=|==|!=|
			=>|->|<<|>>|<|>|!|~|
			&&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|%
		  }x;

our $NonptrType;
our $Type;
our $Declare;

our $NON_ASCII_UTF8	= qr{
	[\xC2-\xDF][\x80-\xBF]               # non-overlong 2-byte
	|  \xE0[\xA0-\xBF][\x80-\xBF]        # excluding overlongs
	| [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}  # straight 3-byte
	|  \xED[\x80-\x9F][\x80-\xBF]        # excluding surrogates
	|  \xF0[\x90-\xBF][\x80-\xBF]{2}     # planes 1-3
	| [\xF1-\xF3][\x80-\xBF]{3}          # planes 4-15
	|  \xF4[\x80-\x8F][\x80-\xBF]{2}     # plane 16
}x;

our $UTF8	= qr{
	[\x09\x0A\x0D\x20-\x7E]              # ASCII
	| $NON_ASCII_UTF8
}x;

# some readers default to ISO-8859-1 when showing email source. detect
# when UTF-8 is incorrectly interpreted as ISO-8859-1 and reencoded back.
# False positives are possible but very unlikely.
our $UTF8_MOJIBAKE = qr{
	\xC3[\x82-\x9F] \xC2[\x80-\xBF]                    # c2-df 80-bf
	| \xC3\xA0 \xC2[\xA0-\xBF] \xC2[\x80-\xBF]         # e0 a0-bf 80-bf
	| \xC3[\xA1-\xAC\xAE\xAF] (?: \xC2[\x80-\xBF]){2}  # e1-ec/ee/ef 80-bf 80-bf
	| \xC3\xAD \xC2[\x80-\x9F] \xC2[\x80-\xBF]         # ed 80-9f 80-bf
	| \xC3\xB0 \xC2[\x90-\xBF] (?: \xC2[\x80-\xBF]){2} # f0 90-bf 80-bf 80-bf
	| \xC3[\xB1-\xB3] (?: \xC2[\x80-\xBF]){3}          # f1-f3 80-bf 80-bf 80-bf
	| \xC3\xB4 \xC2[\x80-\x8F] (?: \xC2[\x80-\xBF]){2} # f4 80-b8 80-bf 80-bf
}x;

# There are still some false positives, but this catches most
# common cases.
our $typeTypedefs = qr{(?x:
        (?![KMGTPE]iB)                      # IEC binary prefix (do not match)
        [A-Z][A-Z\d_]*[a-z][A-Za-z\d_]*     # camelcase
        | [A-Z][A-Z\d_]*AIOCB               # all uppercase
        | [A-Z][A-Z\d_]*CPU                 # all uppercase
        | QEMUBH                            # all uppercase
)};

our @typeList = (
	qr{void},
	qr{(?:unsigned\s+)?char},
	qr{(?:unsigned\s+)?short},
	qr{(?:unsigned\s+)?int},
	qr{(?:unsigned\s+)?long},
	qr{(?:unsigned\s+)?long\s+int},
	qr{(?:unsigned\s+)?long\s+long},
	qr{(?:unsigned\s+)?long\s+long\s+int},
	qr{unsigned},
	qr{float},
	qr{double},
	qr{bool},
	qr{struct\s+$Ident},
	qr{union\s+$Ident},
	qr{enum\s+$Ident},
	qr{${Ident}_t},
	qr{${Ident}_handler},
	qr{${Ident}_handler_fn},
	qr{target_(?:u)?long},
	qr{hwaddr},
        # external libraries
	qr{xen\w+_handle},
	# Glib definitions
	qr{gchar},
	qr{gshort},
	qr{glong},
	qr{gint},
	qr{gboolean},
	qr{guchar},
	qr{gushort},
	qr{gulong},
	qr{guint},
	qr{gfloat},
	qr{gdouble},
	qr{gpointer},
	qr{gconstpointer},
	qr{gint8},
	qr{guint8},
	qr{gint16},
	qr{guint16},
	qr{gint32},
	qr{guint32},
	qr{gint64},
	qr{guint64},
	qr{gsize},
	qr{gssize},
	qr{goffset},
	qr{gintptr},
	qr{guintptr},
);

# Load common spelling mistakes and build regular expression list.
my $misspellings;
my %spelling_fix;

if ($codespell) {
	if (open(my $spelling, '<', $codespellfile)) {
		while (<$spelling>) {
			my $line = $_;

			$line =~ s/\s*\n?$//g;
			$line =~ s/^\s*//g;

			next if ($line =~ m/^\s*#/);
			next if ($line =~ m/^\s*$/);
			next if ($line =~ m/, disabled/i);

			$line =~ s/,.*$//;

			my ($suspect, $fix) = split(/->/, $line);

			$spelling_fix{$suspect} = $fix;
		}
		close($spelling);
	} else {
		warn "No codespell typos will be found - file '$codespellfile': $!\n";
	}
}

$misspellings = join("|", sort keys %spelling_fix) if keys %spelling_fix;

# This can be modified by sub possible.  Since it can be empty, be careful
# about regexes that always match, because they can cause infinite loops.
our @modifierList = (
);

sub build_types {
	my $all = "(?x:  \n" . join("|\n  ", @typeList) . "\n)";
	if (@modifierList > 0) {
		my $mods = "(?x:  \n" . join("|\n  ", @modifierList) . "\n)";
		$Modifier = qr{(?:$Attribute|$Sparse|$mods)};
	} else {
		$Modifier = qr{(?:$Attribute|$Sparse)};
	}
	$NonptrType	= qr{
			(?:$Modifier\s+|const\s+)*
			(?:
				(?:typeof|__typeof__)\s*\(\s*\**\s*$Ident\s*\)|
				(?:$typeTypedefs\b)|
				(?:${all}\b)
			)
			(?:\s+$Modifier|\s+const)*
		  }x;
	$Type	= qr{
			$NonptrType
			(?:[\s\*]+\s*const|[\s\*]+|(?:\s*\[\s*\])+)?
			(?:\s+$Inline|\s+$Modifier)*
		  }x;
	$Declare	= qr{(?:$Storage\s+)?$Type};
}
build_types();

$chk_signoff = 0 if ($file);

my @rawlines = ();
my @lines = ();
my $vname;
if ($chk_branch) {
	my @patches;
	my %git_commits = ();
	my $HASH;
	open($HASH, "-|", "git", "log", "--reverse", "--no-merges", "--no-mailmap", "--format=%H %s", $ARGV[0]) ||
		die "$P: git log --reverse --no-merges --no-mailmap --format='%H %s' $ARGV[0] failed - $!\n";

	for my $line (<$HASH>) {
		$line =~ /^([0-9a-fA-F]{40,40}) (.*)$/;
		next if (!defined($1) || !defined($2));
		my $sha1 = $1;
		my $subject = $2;
		push(@patches, $sha1);
		$git_commits{$sha1} = $subject;
	}

	close $HASH;

	die "$P: no revisions returned for revlist '$ARGV[0]'\n"
	    unless @patches;

	my $i = 1;
	my $num_patches = @patches;
	for my $hash (@patches) {
		my $FILE;
		open($FILE, '-|', "git",
                     "-c", "diff.renamelimit=0",
                     "-c", "diff.renames=True",
                     "-c", "diff.algorithm=histogram",
                     "show", "--no-mailmap",
                     "--patch-with-stat", $hash) ||
			die "$P: git show $hash - $!\n";
		while (<$FILE>) {
			chomp;
			push(@rawlines, $_);
		}
		close($FILE);
		$vname = substr($hash, 0, 12) . ' (' . $git_commits{$hash} . ')';
		if ($num_patches > 1 && $quiet == 0) {
			my $prefix = "$i/$num_patches";
			$prefix = BLUE . BOLD . $prefix . RESET if $color;
			print "$prefix Checking commit $vname\n";
			$vname = "Patch $i/$num_patches";
		} else {
			$vname = "Commit " . $vname;
		}
		if (!process($hash)) {
			$exit = 1;
			print "\n" if ($num_patches > 1 && $quiet == 0);
		}
		@rawlines = ();
		@lines = ();
		$i++;
	}
} else {
	for my $filename (@ARGV) {
		my $FILE;
		if ($file) {
			open($FILE, '-|', "diff -u /dev/null $filename") ||
				die "$P: $filename: diff failed - $!\n";
		} elsif ($filename eq '-') {
			open($FILE, '<&STDIN');
		} else {
			open($FILE, '<', "$filename") ||
				die "$P: $filename: open failed - $!\n";
		}
		if ($filename eq '-') {
			$vname = 'Your patch';
		} else {
			$vname = $filename;
		}
		print "Checking $filename...\n" if @ARGV > 1 && $quiet == 0;
		while (<$FILE>) {
			chomp;
			push(@rawlines, $_);
		}
		close($FILE);
		if (!process($filename)) {
			$exit = 1;
		}
		@rawlines = ();
		@lines = ();
	}
}

exit($exit);

sub top_of_kernel_tree {
	my ($root) = @_;

	my @tree_check = (
		"COPYING", "MAINTAINERS", "Makefile",
		"README.rst", "docs", "VERSION",
		"linux-user", "system"
	);

	foreach my $check (@tree_check) {
		if (! -e $root . '/' . $check) {
			return 0;
		}
	}
	return 1;
}

sub which {
	my ($bin) = @_;

	foreach my $path (split(/:/, $ENV{PATH})) {
		if (-e "$path/$bin") {
			return "$path/$bin";
		}
	}

	return "";
}

sub expand_tabs {
	my ($str) = @_;

	my $res = '';
	my $n = 0;
	for my $c (split(//, $str)) {
		if ($c eq "\t") {
			$res .= ' ';
			$n++;
			for (; ($n % 8) != 0; $n++) {
				$res .= ' ';
			}
			next;
		}
		$res .= $c;
		$n++;
	}

	return $res;
}
sub copy_spacing {
	(my $res = shift) =~ tr/\t/ /c;
	return $res;
}

sub line_stats {
	my ($line) = @_;

	# Drop the diff line leader and expand tabs
	$line =~ s/^.//;
	$line = expand_tabs($line);

	# Pick the indent from the front of the line.
	my ($white) = ($line =~ /^(\s*)/);

	return (length($line), length($white));
}

my $sanitise_quote = '';

sub sanitise_line_reset {
	my ($in_comment) = @_;

	if ($in_comment) {
		$sanitise_quote = '*/';
	} else {
		$sanitise_quote = '';
	}
}
sub sanitise_line {
	my ($line) = @_;

	my $res = '';
	my $l = '';

	my $qlen = 0;
	my $off = 0;
	my $c;

	# Always copy over the diff marker.
	$res = substr($line, 0, 1);

	for ($off = 1; $off < length($line); $off++) {
		$c = substr($line, $off, 1);

		# Comments we are wacking completely including the begin
		# and end, all to $;.
		if ($sanitise_quote eq '' && substr($line, $off, 2) eq '/*') {
			$sanitise_quote = '*/';

			substr($res, $off, 2, "$;$;");
			$off++;
			next;
		}
		if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') {
			$sanitise_quote = '';
			substr($res, $off, 2, "$;$;");
			$off++;
			next;
		}
		if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') {
			$sanitise_quote = '//';

			substr($res, $off, 2, $sanitise_quote);
			$off++;
			next;
		}

		# A \ in a string means ignore the next character.
		if (($sanitise_quote eq "'" || $sanitise_quote eq '"') &&
		    $c eq "\\") {
			substr($res, $off, 2, 'XX');
			$off++;
			next;
		}
		# Regular quotes.
		if ($c eq "'" || $c eq '"') {
			if ($sanitise_quote eq '') {
				$sanitise_quote = $c;

				substr($res, $off, 1, $c);
				next;
			} elsif ($sanitise_quote eq $c) {
				$sanitise_quote = '';
			}
		}

		#print "c<$c> SQ<$sanitise_quote>\n";
		if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") {
			substr($res, $off, 1, $;);
		} elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") {
			substr($res, $off, 1, $;);
		} elsif ($off != 0 && $sanitise_quote && $c ne "\t") {
			substr($res, $off, 1, 'X');
		} else {
			substr($res, $off, 1, $c);
		}
	}

	if ($sanitise_quote eq '//') {
		$sanitise_quote = '';
	}

	# The pathname on a #include may be surrounded by '<' and '>'.
	if ($res =~ /^.\s*\#\s*include\s+\<(.*)\>/) {
		my $clean = 'X' x length($1);
		$res =~ s@\<.*\>@<$clean>@;

	# The whole of a #error is a string.
	} elsif ($res =~ /^.\s*\#\s*(?:error|warning)\s+(.*)\b/) {
		my $clean = 'X' x length($1);
		$res =~ s@(\#\s*(?:error|warning)\s+).*@$1$clean@;
	}

	return $res;
}

sub ctx_statement_block {
	my ($linenr, $remain, $off) = @_;
	my $line = $linenr - 1;
	my $blk = '';
	my $soff = $off;
	my $coff = $off - 1;
	my $coff_set = 0;

	my $loff = 0;

	my $type = '';
	my $level = 0;
	my @stack = ();
	my $p;
	my $c;
	my $len = 0;

	my $remainder;
	while (1) {
		@stack = (['', 0]) if ($#stack == -1);

		#warn "CSB: blk<$blk> remain<$remain>\n";
		# If we are about to drop off the end, pull in more
		# context.
		if ($off >= $len) {
			for (; $remain > 0; $line++) {
				last if (!defined $lines[$line]);
				next if ($lines[$line] =~ /^-/);
				$remain--;
				$loff = $len;
				$blk .= $lines[$line] . "\n";
				$len = length($blk);
				$line++;
				last;
			}
			# Bail if there is no further context.
			#warn "CSB: blk<$blk> off<$off> len<$len>\n";
			if ($off >= $len) {
				last;
			}
		}
		$p = $c;
		$c = substr($blk, $off, 1);
		$remainder = substr($blk, $off);

		#warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>\n";

		# Handle nested #if/#else.
		if ($remainder =~ /^#\s*(?:ifndef|ifdef|if)\s/) {
			push(@stack, [ $type, $level ]);
		} elsif ($remainder =~ /^#\s*(?:else|elif)\b/) {
			($type, $level) = @{$stack[$#stack - 1]};
		} elsif ($remainder =~ /^#\s*endif\b/) {
			($type, $level) = @{pop(@stack)};
		}

		# Statement ends at the ';' or a close '}' at the
		# outermost level.
		if ($level == 0 && $c eq ';') {
			last;
		}

		# An else is really a conditional as long as its not else if
		if ($level == 0 && $coff_set == 0 &&
				(!defined($p) || $p =~ /(?:\s|\}|\+)/) &&
				$remainder =~ /^(else)(?:\s|{)/ &&
				$remainder !~ /^else\s+if\b/) {
			$coff = $off + length($1) - 1;
			$coff_set = 1;
			#warn "CSB: mark coff<$coff> soff<$soff> 1<$1>\n";
			#warn "[" . substr($blk, $soff, $coff - $soff + 1) . "]\n";
		}

		if (($type eq '' || $type eq '(') && $c eq '(') {
			$level++;
			$type = '(';
		}
		if ($type eq '(' && $c eq ')') {
			$level--;
			$type = ($level != 0)? '(' : '';

			if ($level == 0 && $coff < $soff) {
				$coff = $off;
				$coff_set = 1;
				#warn "CSB: mark coff<$coff>\n";
			}
		}
		if (($type eq '' || $type eq '{') && $c eq '{') {
			$level++;
			$type = '{';
		}
		if ($type eq '{' && $c eq '}') {
			$level--;
			$type = ($level != 0)? '{' : '';

			if ($level == 0) {
				if (substr($blk, $off + 1, 1) eq ';') {
					$off++;
				}
				last;
			}
		}
		$off++;
	}
	# We are truly at the end, so shuffle to the next line.
	if ($off == $len) {
		$loff = $len + 1;
		$line++;
		$remain--;
	}

	my $statement = substr($blk, $soff, $off - $soff + 1);
	my $condition = substr($blk, $soff, $coff - $soff + 1);

	#warn "STATEMENT<$statement>\n";
	#warn "CONDITION<$condition>\n";

	#print "coff<$coff> soff<$off> loff<$loff>\n";

	return ($statement, $condition,
			$line, $remain + 1, $off - $loff + 1, $level);
}

sub statement_lines {
	my ($stmt) = @_;

	# Strip the diff line prefixes and rip blank lines at start and end.
	$stmt =~ s/(^|\n)./$1/g;
	$stmt =~ s/^\s*//;
	$stmt =~ s/\s*$//;

	my @stmt_lines = ($stmt =~ /\n/g);

	return $#stmt_lines + 2;
}

sub statement_rawlines {
	my ($stmt) = @_;

	my @stmt_lines = ($stmt =~ /\n/g);

	return $#stmt_lines + 2;
}

sub statement_block_size {
	my ($stmt) = @_;

	$stmt =~ s/(^|\n)./$1/g;
	$stmt =~ s/^\s*\{//;
	$stmt =~ s/}\s*$//;
	$stmt =~ s/^\s*//;
	$stmt =~ s/\s*$//;

	my @stmt_lines = ($stmt =~ /\n/g);
	my @stmt_statements = ($stmt =~ /;/g);

	my $stmt_lines = $#stmt_lines + 2;
	my $stmt_statements = $#stmt_statements + 1;

	if ($stmt_lines > $stmt_statements) {
		return $stmt_lines;
	} else {
		return $stmt_statements;
	}
}

sub ctx_statement_full {
	my ($linenr, $remain, $off) = @_;
	my ($statement, $condition, $level);

	my (@chunks);

	# Grab the first conditional/block pair.
	($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
	#print "F: c<$condition> s<$statement> remain<$remain>\n";
	push(@chunks, [ $condition, $statement ]);
	if (!($remain > 0 && $condition =~ /^\s*(?:\n[+-])?\s*(?:if|else|do)\b/s)) {
		return ($level, $linenr, @chunks);
	}

	# Pull in the following conditional/block pairs and see if they
	# could continue the statement.
	for (;;) {
		($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
		#print "C: c<$condition> s<$statement> remain<$remain>\n";
		last if (!($remain > 0 && $condition =~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s));
		#print "C: push\n";
		push(@chunks, [ $condition, $statement ]);
	}

	return ($level, $linenr, @chunks);
}

sub ctx_block_get {
	my ($linenr, $remain, $outer, $open, $close, $off) = @_;
	my $line;
	my $start = $linenr - 1;
	my $blk = '';
	my @o;
	my @c;
	my @res = ();

	my $level = 0;
	my @stack = ($level);
	for ($line = $start; $remain > 0; $line++) {
		next if ($rawlines[$line] =~ /^-/);
		$remain--;

		$blk .= $rawlines[$line];

		# Handle nested #if/#else.
		if ($lines[$line] =~ /^.\s*#\s*(?:ifndef|ifdef|if)\s/) {
			push(@stack, $level);
		} elsif ($lines[$line] =~ /^.\s*#\s*(?:else|elif)\b/) {
			$level = $stack[$#stack - 1];
		} elsif ($lines[$line] =~ /^.\s*#\s*endif\b/) {
			$level = pop(@stack);
		}

		foreach my $c (split(//, $lines[$line])) {
			##print "C<$c>L<$level><$open$close>O<$off>\n";
			if ($off > 0) {
				$off--;
				next;
			}

			if ($c eq $close && $level > 0) {
				$level--;
				last if ($level == 0);
			} elsif ($c eq $open) {
				$level++;
			}
		}

		if (!$outer || $level <= 1) {
			push(@res, $rawlines[$line]);
		}

		last if ($level == 0);
	}

	return ($level, @res);
}
sub ctx_block_outer {
	my ($linenr, $remain) = @_;

	my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0);
	return @r;
}
sub ctx_block {
	my ($linenr, $remain) = @_;

	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0);
	return @r;
}
sub ctx_statement {
	my ($linenr, $remain, $off) = @_;

	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '(', ')', $off);
	return @r;
}
sub ctx_block_level {
	my ($linenr, $remain) = @_;

	return ctx_block_get($linenr, $remain, 0, '{', '}', 0);
}
sub ctx_statement_level {
	my ($linenr, $remain, $off) = @_;

	return ctx_block_get($linenr, $remain, 0, '(', ')', $off);
}

sub ctx_locate_comment {
	my ($first_line, $end_line) = @_;

	# Catch a comment on the end of the line itself.
	my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@);
	return $current_comment if (defined $current_comment);

	# Look through the context and try and figure out if there is a
	# comment.
	my $in_comment = 0;
	$current_comment = '';
	for (my $linenr = $first_line; $linenr < $end_line; $linenr++) {
		my $line = $rawlines[$linenr - 1];
		#warn "           $line\n";
		if ($linenr == $first_line and $line =~ m@^.\s*\*@) {
			$in_comment = 1;
		}
		if ($line =~ m@/\*@) {
			$in_comment = 1;
		}
		if (!$in_comment && $current_comment ne '') {
			$current_comment = '';
		}
		$current_comment .= $line . "\n" if ($in_comment);
		if ($line =~ m@\*/@) {
			$in_comment = 0;
		}
	}

	chomp($current_comment);
	return($current_comment);
}
sub ctx_has_comment {
	my ($first_line, $end_line) = @_;
	my $cmt = ctx_locate_comment($first_line, $end_line);

	##print "LINE: $rawlines[$end_line - 1 ]\n";
	##print "CMMT: $cmt\n";

	return ($cmt ne '');