checkpatch.pl 88.2 KB
Newer Older
1
#!/usr/bin/perl -w
2
# (c) 2001, Dave Jones. (the file handling bit)
3
# (c) 2005, Joel Schopp <jschopp@austin.ibm.com> (the ugly bit)
Andy Whitcroft's avatar
Andy Whitcroft committed
4
# (c) 2007,2008, Andy Whitcroft <apw@uk.ibm.com> (new conditions, test suite)
5
# (c) 2008-2010 Andy Whitcroft <apw@canonical.com>
6 7 8 9 10
# Licensed under the terms of the GNU GPL License version 2

use strict;

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

13
my $V = '0.32';
14 15 16 17 18 19 20

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

my $quiet = 0;
my $tree = 1;
my $chk_signoff = 1;
my $chk_patch = 1;
21
my $tst_only;
22
my $emacs = 0;
23
my $terse = 0;
24 25
my $file = 0;
my $check = 0;
26 27
my $summary = 1;
my $mailback = 0;
28
my $summary_file = 0;
29
my $show_types = 0;
30
my $root;
31
my %debug;
32 33
my %ignore_type = ();
my @ignore = ();
34
my $help = 0;
35
my $configuration_file = ".checkpatch.conf";
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52

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

	print << "EOM";
Usage: $P [OPTION]... [FILE]...
Version: $V

Options:
  -q, --quiet                quiet
  --no-tree                  run without a kernel tree
  --no-signoff               do not check for 'Signed-off-by' line
  --patch                    treat FILE as patchfile (default)
  --emacs                    emacs compile window format
  --terse                    one line per report
  -f, --file                 treat FILE as regular source file
  --subjective, --strict     enable more subjective tests
53 54
  --ignore TYPE(,TYPE2...)   ignore various comma separated message types
  --show-types               show the message "types" in the output
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
  --root=PATH                PATH to the kernel 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
  -h, --help, --version      display this help and exit

When FILE is - read standard input.
EOM

	exit($exitcode);
}

72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
my $conf = which_conf($configuration_file);
if (-f $conf) {
	my @conf_args;
	open(my $conffile, '<', "$conf")
	    or warn "$P: Can't find a readable $configuration_file file $!\n";

	while (<$conffile>) {
		my $line = $_;

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

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

		my @words = split(" ", $line);
		foreach my $word (@words) {
			last if ($word =~ m/^#/);
			push (@conf_args, $word);
		}
	}
	close($conffile);
	unshift(@ARGV, @conf_args) if @conf_args;
}

98
GetOptions(
99
	'q|quiet+'	=> \$quiet,
100 101 102
	'tree!'		=> \$tree,
	'signoff!'	=> \$chk_signoff,
	'patch!'	=> \$chk_patch,
103
	'emacs!'	=> \$emacs,
104
	'terse!'	=> \$terse,
105
	'f|file!'	=> \$file,
106 107
	'subjective!'	=> \$check,
	'strict!'	=> \$check,
108 109
	'ignore=s'	=> \@ignore,
	'show-types!'	=> \$show_types,
110
	'root=s'	=> \$root,
111 112
	'summary!'	=> \$summary,
	'mailback!'	=> \$mailback,
113 114
	'summary-file!'	=> \$summary_file,

115
	'debug=s'	=> \%debug,
116
	'test-only=s'	=> \$tst_only,
117 118 119 120 121
	'h|help'	=> \$help,
	'version'	=> \$help
) or help(1);

help(0) if ($help);
122 123 124 125

my $exit = 0;

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

130 131 132 133 134 135 136 137 138 139 140 141 142
@ignore = split(/,/, join(',',@ignore));
foreach my $word (@ignore) {
	$word =~ s/\s*\n?$//g;
	$word =~ s/^\s*//g;
	$word =~ s/\s+/ /g;
	$word =~ tr/[a-z]/[A-Z]/;

	next if ($word =~ m/^\s*#/);
	next if ($word =~ m/^\s*$/);

	$ignore_type{$word}++;
}

143 144
my $dbg_values = 0;
my $dbg_possible = 0;
145
my $dbg_type = 0;
146
my $dbg_attr = 0;
147
for my $key (keys %debug) {
148 149 150
	## no critic
	eval "\${dbg_$key} = '$debug{$key}';";
	die "$@" if ($@);
151 152
}

153 154
my $rpt_cleaners = 0;

155 156 157 158 159
if ($terse) {
	$emacs = 1;
	$quiet++;
}

160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
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 kernel tree\n";
		exit(2);
	}
178 179
}

180 181
my $emitted_corrupt = 0;

182 183 184 185
our $Ident	= qr{
			[A-Za-z_][A-Za-z\d_]*
			(?:\s*\#\#\s*[A-Za-z_][A-Za-z\d_]*)*
		}x;
186 187 188 189 190 191 192 193
our $Storage	= qr{extern|static|asmlinkage};
our $Sparse	= qr{
			__user|
			__kernel|
			__force|
			__iomem|
			__must_check|
			__init_refok|
194
			__kprobes|
195 196
			__ref|
			__rcu
197
		}x;
198 199 200

# Notes to $Attribute:
# We need \b after 'init' otherwise 'initconst' will cause a false positive in a check
201 202
our $Attribute	= qr{
			const|
203 204 205 206 207 208 209 210 211 212 213 214 215 216
			__percpu|
			__nocast|
			__safe|
			__bitwise__|
			__packed__|
			__packed2__|
			__naked|
			__maybe_unused|
			__always_unused|
			__noreturn|
			__used|
			__cold|
			__noclone|
			__deprecated|
217 218
			__read_mostly|
			__kprobes|
219
			__(?:mem|cpu|dev|)(?:initdata|initconst|init\b)|
220 221
			____cacheline_aligned|
			____cacheline_aligned_in_smp|
222 223
			____cacheline_internodealigned_in_smp|
			__weak
224
		  }x;
225
our $Modifier;
226 227 228 229 230 231
our $Inline	= qr{inline|__always_inline|noinline};
our $Member	= qr{->$Ident|\.$Ident|\[[^]]*\]};
our $Lval	= qr{$Ident(?:$Member)*};

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

239 240 241 242
our $NonptrType;
our $Type;
our $Declare;

243 244 245 246 247 248 249 250 251 252 253
our $UTF8	= qr {
	[\x09\x0A\x0D\x20-\x7E]              # ASCII
	| [\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;

254
our $typeTypedefs = qr{(?x:
255
	(?:__)?(?:u|s|be|le)(?:8|16|32|64)|
256 257 258
	atomic_t
)};

259
our $logFunctions = qr{(?x:
260 261 262
	printk(?:_ratelimited|_once|)|
	[a-z0-9]+_(?:printk|emerg|alert|crit|err|warning|warn|notice|info|debug|dbg|vdbg|devel|cont|WARN)(?:_ratelimited|_once|)|
	WARN(?:_RATELIMIT|_ONCE|)|
263 264
	panic|
	MODULE_[A-Z_]+
265 266
)};

267 268 269 270 271 272 273 274 275 276
our $signature_tags = qr{(?xi:
	Signed-off-by:|
	Acked-by:|
	Tested-by:|
	Reviewed-by:|
	Reported-by:|
	To:|
	Cc:
)};

277 278
our @typeList = (
	qr{void},
279 280 281 282 283 284 285
	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},
286 287 288 289 290 291 292 293 294 295 296
	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},
);
297 298 299
our @modifierList = (
	qr{fastcall},
);
300

301 302 303 304 305 306
our $allowed_asm_includes = qr{(?x:
	irq|
	memory
)};
# memory.h: ARM has a custom one

307
sub build_types {
308 309
	my $mods = "(?x:  \n" . join("|\n  ", @modifierList) . "\n)";
	my $all = "(?x:  \n" . join("|\n  ", @typeList) . "\n)";
310
	$Modifier	= qr{(?:$Attribute|$Sparse|$mods)};
311
	$NonptrType	= qr{
312
			(?:$Modifier\s+|const\s+)*
313
			(?:
314
				(?:typeof|__typeof__)\s*\(\s*\**\s*$Ident\s*\)|
315
				(?:$typeTypedefs\b)|
316
				(?:${all}\b)
317
			)
318
			(?:\s+$Modifier|\s+const)*
319 320
		  }x;
	$Type	= qr{
321
			$NonptrType
322
			(?:[\s\*]+\s*const|[\s\*]+|(?:\s*\[\s*\])+)?
323
			(?:\s+$Inline|\s+$Modifier)*
324 325 326 327
		  }x;
	$Declare	= qr{(?:$Storage\s+)?$Type};
}
build_types();
328

329 330 331 332 333 334 335 336 337 338 339 340 341 342
our $match_balanced_parentheses = qr/(\((?:[^\(\)]+|(-1))*\))/;

our $Typecast	= qr{\s*(\(\s*$NonptrType\s*\)){0,1}\s*};
our $LvalOrFunc	= qr{($Lval)\s*($match_balanced_parentheses{0,1})\s*};

sub deparenthesize {
	my ($string) = @_;
	return "" if (!defined($string));
	$string =~ s@^\s*\(\s*@@g;
	$string =~ s@\s*\)\s*$@@g;
	$string =~ s@\s+@ @g;
	return $string;
}

343 344
$chk_signoff = 0 if ($file);

345 346
my @dep_includes = ();
my @dep_functions = ();
347 348
my $removal = "Documentation/feature-removal-schedule.txt";
if ($tree && -f "$root/$removal") {
349
	open(my $REMOVE, '<', "$root/$removal") ||
350
				die "$P: $removal: open failed - $!\n";
351
	while (<$REMOVE>) {
352 353 354
		if (/^Check:\s+(.*\S)/) {
			for my $entry (split(/[, ]+/, $1)) {
				if ($entry =~ m@include/(.*)@) {
355 356
					push(@dep_includes, $1);

357 358 359
				} elsif ($entry !~ m@/@) {
					push(@dep_functions, $entry);
				}
360
			}
361 362
		}
	}
363
	close($REMOVE);
364 365
}

366
my @rawlines = ();
367 368
my @lines = ();
my $vname;
369
for my $filename (@ARGV) {
370
	my $FILE;
371
	if ($file) {
372
		open($FILE, '-|', "diff -u /dev/null $filename") ||
373
			die "$P: $filename: diff failed - $!\n";
374 375
	} elsif ($filename eq '-') {
		open($FILE, '<&STDIN');
376
	} else {
377
		open($FILE, '<', "$filename") ||
378
			die "$P: $filename: open failed - $!\n";
379
	}
380 381 382 383 384
	if ($filename eq '-') {
		$vname = 'Your patch';
	} else {
		$vname = $filename;
	}
385
	while (<$FILE>) {
386 387 388
		chomp;
		push(@rawlines, $_);
	}
389
	close($FILE);
390
	if (!process($filename)) {
391 392 393
		$exit = 1;
	}
	@rawlines = ();
394
	@lines = ();
395 396 397 398 399
}

exit($exit);

sub top_of_kernel_tree {
400 401 402 403 404 405 406 407 408 409 410 411
	my ($root) = @_;

	my @tree_check = (
		"COPYING", "CREDITS", "Kbuild", "MAINTAINERS", "Makefile",
		"README", "Documentation", "arch", "include", "drivers",
		"fs", "init", "ipc", "kernel", "lib", "scripts",
	);

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

416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485
sub parse_email {
	my ($formatted_email) = @_;

	my $name = "";
	my $address = "";
	my $comment = "";

	if ($formatted_email =~ /^(.*)<(\S+\@\S+)>(.*)$/) {
		$name = $1;
		$address = $2;
		$comment = $3 if defined $3;
	} elsif ($formatted_email =~ /^\s*<(\S+\@\S+)>(.*)$/) {
		$address = $1;
		$comment = $2 if defined $2;
	} elsif ($formatted_email =~ /(\S+\@\S+)(.*)$/) {
		$address = $1;
		$comment = $2 if defined $2;
		$formatted_email =~ s/$address.*$//;
		$name = $formatted_email;
		$name =~ s/^\s+|\s+$//g;
		$name =~ s/^\"|\"$//g;
		# If there's a name left after stripping spaces and
		# leading quotes, and the address doesn't have both
		# leading and trailing angle brackets, the address
		# is invalid. ie:
		#   "joe smith joe@smith.com" bad
		#   "joe smith <joe@smith.com" bad
		if ($name ne "" && $address !~ /^<[^>]+>$/) {
			$name = "";
			$address = "";
			$comment = "";
		}
	}

	$name =~ s/^\s+|\s+$//g;
	$name =~ s/^\"|\"$//g;
	$address =~ s/^\s+|\s+$//g;
	$address =~ s/^\<|\>$//g;

	if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
		$name =~ s/(?<!\\)"/\\"/g; ##escape quotes
		$name = "\"$name\"";
	}

	return ($name, $address, $comment);
}

sub format_email {
	my ($name, $address) = @_;

	my $formatted_email;

	$name =~ s/^\s+|\s+$//g;
	$name =~ s/^\"|\"$//g;
	$address =~ s/^\s+|\s+$//g;

	if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
		$name =~ s/(?<!\\)"/\\"/g; ##escape quotes
		$name = "\"$name\"";
	}

	if ("$name" eq "") {
		$formatted_email = "$address";
	} else {
		$formatted_email = "$name <$address>";
	}

	return $formatted_email;
}

486 487 488 489 490 491 492 493 494 495 496 497
sub which_conf {
	my ($conf) = @_;

	foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
		if (-e "$path/$conf") {
			return "$path/$conf";
		}
	}

	return "";
}

498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517
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;
}
518
sub copy_spacing {
519
	(my $res = shift) =~ tr/\t/ /c;
520 521
	return $res;
}
522

523 524 525 526 527 528 529 530 531 532 533 534 535
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));
}

536 537 538 539 540 541 542 543 544 545 546
my $sanitise_quote = '';

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

	if ($in_comment) {
		$sanitise_quote = '*/';
	} else {
		$sanitise_quote = '';
	}
}
547 548 549 550 551 552
sub sanitise_line {
	my ($line) = @_;

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

553
	my $qlen = 0;
554 555
	my $off = 0;
	my $c;
556

557 558 559 560 561 562 563 564 565 566 567 568 569 570
	# 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 completly including the begin
		# and end, all to $;.
		if ($sanitise_quote eq '' && substr($line, $off, 2) eq '/*') {
			$sanitise_quote = '*/';

			substr($res, $off, 2, "$;$;");
			$off++;
			next;
571
		}
572
		if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') {
573 574 575 576
			$sanitise_quote = '';
			substr($res, $off, 2, "$;$;");
			$off++;
			next;
577
		}
578 579 580 581 582 583 584
		if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') {
			$sanitise_quote = '//';

			substr($res, $off, 2, $sanitise_quote);
			$off++;
			next;
		}
585 586 587 588 589 590 591

		# 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;
592
		}
593 594 595 596
		# Regular quotes.
		if ($c eq "'" || $c eq '"') {
			if ($sanitise_quote eq '') {
				$sanitise_quote = $c;
597

598 599 600 601 602 603
				substr($res, $off, 1, $c);
				next;
			} elsif ($sanitise_quote eq $c) {
				$sanitise_quote = '';
			}
		}
604

605
		#print "c<$c> SQ<$sanitise_quote>\n";
606 607
		if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") {
			substr($res, $off, 1, $;);
608 609
		} elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") {
			substr($res, $off, 1, $;);
610 611 612 613 614
		} elsif ($off != 0 && $sanitise_quote && $c ne "\t") {
			substr($res, $off, 1, 'X');
		} else {
			substr($res, $off, 1, $c);
		}
615 616
	}

617 618 619 620
	if ($sanitise_quote eq '//') {
		$sanitise_quote = '';
	}

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

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

632 633 634
	return $res;
}

635 636 637 638 639 640
sub ctx_statement_block {
	my ($linenr, $remain, $off) = @_;
	my $line = $linenr - 1;
	my $blk = '';
	my $soff = $off;
	my $coff = $off - 1;
641
	my $coff_set = 0;
642

643 644
	my $loff = 0;

645 646
	my $type = '';
	my $level = 0;
647
	my @stack = ();
648
	my $p;
649 650
	my $c;
	my $len = 0;
651 652

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

656
		#warn "CSB: blk<$blk> remain<$remain>\n";
657 658 659 660
		# If we are about to drop off the end, pull in more
		# context.
		if ($off >= $len) {
			for (; $remain > 0; $line++) {
661
				last if (!defined $lines[$line]);
662
				next if ($lines[$line] =~ /^-/);
663
				$remain--;
664
				$loff = $len;
665
				$blk .= $lines[$line] . "\n";
666 667 668 669 670 671
				$len = length($blk);
				$line++;
				last;
			}
			# Bail if there is no further context.
			#warn "CSB: blk<$blk> off<$off> len<$len>\n";
672
			if ($off >= $len) {
673 674 675
				last;
			}
		}
676
		$p = $c;
677
		$c = substr($blk, $off, 1);
678
		$remainder = substr($blk, $off);
679

680
		#warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>\n";
681 682 683 684 685 686 687 688 689 690

		# 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)};
		}

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

697
		# An else is really a conditional as long as its not else if
698 699 700 701 702 703 704 705
		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";
706 707
		}

708 709 710 711 712 713 714 715 716 717
		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;
718 719
				$coff_set = 1;
				#warn "CSB: mark coff<$coff>\n";
720 721 722 723 724 725 726 727 728 729 730
			}
		}
		if (($type eq '' || $type eq '{') && $c eq '{') {
			$level++;
			$type = '{';
		}
		if ($type eq '{' && $c eq '}') {
			$level--;
			$type = ($level != 0)? '{' : '';

			if ($level == 0) {
731 732 733
				if (substr($blk, $off + 1, 1) eq ';') {
					$off++;
				}
734 735 736 737 738
				last;
			}
		}
		$off++;
	}
739
	# We are truly at the end, so shuffle to the next line.
740
	if ($off == $len) {
741
		$loff = $len + 1;
742 743 744
		$line++;
		$remain--;
	}
745 746 747 748 749 750 751

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

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

752
	#print "coff<$coff> soff<$off> loff<$loff>\n";
753 754 755 756 757

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

758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800
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;
	}
}

801 802 803 804 805 806
sub ctx_statement_full {
	my ($linenr, $remain, $off) = @_;
	my ($statement, $condition, $level);

	my (@chunks);

807
	# Grab the first conditional/block pair.
808 809
	($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
810
	#print "F: c<$condition> s<$statement> remain<$remain>\n";
811 812 813 814 815 816 817
	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.
818 819 820
	for (;;) {
		($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
821
		#print "C: c<$condition> s<$statement> remain<$remain>\n";
822
		last if (!($remain > 0 && $condition =~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s));
823 824
		#print "C: push\n";
		push(@chunks, [ $condition, $statement ]);
825 826 827
	}

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

830
sub ctx_block_get {
831
	my ($linenr, $remain, $outer, $open, $close, $off) = @_;
832 833 834 835 836 837 838
	my $line;
	my $start = $linenr - 1;
	my $blk = '';
	my @o;
	my @c;
	my @res = ();

839
	my $level = 0;
840
	my @stack = ($level);
841 842 843 844 845
	for ($line = $start; $remain > 0; $line++) {
		next if ($rawlines[$line] =~ /^-/);
		$remain--;

		$blk .= $rawlines[$line];
846 847

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

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

863 864 865 866 867 868 869
			if ($c eq $close && $level > 0) {
				$level--;
				last if ($level == 0);
			} elsif ($c eq $open) {
				$level++;
			}
		}
870

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

875
		last if ($level == 0);
876 877
	}

878
	return ($level, @res);
879 880 881 882
}
sub ctx_block_outer {
	my ($linenr, $remain) = @_;

883 884
	my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0);
	return @r;
885 886 887 888
}
sub ctx_block {
	my ($linenr, $remain) = @_;

889 890
	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0);
	return @r;
891 892
}
sub ctx_statement {
893 894 895 896 897 898
	my ($linenr, $remain, $off) = @_;

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

901
	return ctx_block_get($linenr, $remain, 0, '{', '}', 0);
902
}
903 904 905 906 907
sub ctx_statement_level {
	my ($linenr, $remain, $off) = @_;

	return ctx_block_get($linenr, $remain, 0, '(', ')', $off);
}
908 909 910 911 912

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

	# Catch a comment on the end of the line itself.
913
	my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@);
914 915 916 917 918 919 920
	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++) {
921 922
		my $line = $rawlines[$linenr - 1];
		#warn "           $line\n";
923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944
		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);

945
	##print "LINE: $rawlines[$end_line - 1 ]\n";
946 947 948 949 950
	##print "CMMT: $cmt\n";

	return ($cmt ne '');
}

951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966
sub raw_line {
	my ($linenr, $cnt) = @_;

	my $offset = $linenr - 1;
	$cnt++;

	my $line;
	while ($cnt) {
		$line = $rawlines[$offset++];
		next if (defined($line) && $line =~ /^-/);
		$cnt--;
	}

	return $line;
}

967 968 969
sub cat_vet {
	my ($vet) = @_;
	my ($res, $coded);
970

971 972 973 974 975 976
	$res = '';
	while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) {
		$res .= $1;
		if ($2 ne '') {
			$coded = sprintf("^%c", unpack('C', $2) + 64);
			$res .= $coded;
977 978
		}
	}
979
	$res =~ s/$/\$/;
980

981
	return $res;
982 983
}

984
my $av_preprocessor = 0;
985
my $av_pending;
986
my @av_paren_type;
987
my $av_pend_colon;
988 989 990

sub annotate_reset {
	$av_preprocessor = 0;
991 992
	$av_pending = '_';
	@av_paren_type = ('E');
993
	$av_pend_colon = 'O';
994 995
}

996 997
sub annotate_values {
	my ($stream, $type) = @_;
998

999
	my $res;
1000
	my $var = '_' x length($stream);
1001 1002
	my $cur = $stream;

1003
	print "$stream\n" if ($dbg_values > 1);
1004 1005

	while (length($cur)) {
1006
		@av_paren_type = ('E') if ($#av_paren_type < 0);
1007
		print " <" . join('', @av_paren_type) .
1008
				"> <$type> <$av_pending>" if ($dbg_values > 1);
1009
		if ($cur =~ /^(\s+)/o) {
1010 1011
			print "WS($1)\n" if ($dbg_values > 1);
			if ($1 =~ /\n/ && $av_preprocessor) {
1012
				$type = pop(@av_paren_type);
1013
				$av_preprocessor = 0;
1014 1015
			}

1016
		} elsif ($cur =~ /^(\(\s*$Type\s*)\)/ && $av_pending eq '_') {
1017 1018 1019 1020
			print "CAST($1)\n" if ($dbg_values > 1);
			push(@av_paren_type, $type);
			$type = 'C';

1021
		} elsif ($cur =~ /^($Type)\s*(?:$Ident|,|\)|\(|\s*$)/) {
1022
			print "DECLARE($1)\n" if ($dbg_values > 1);
1023 1024
			$type = 'T';

1025 1026 1027 1028
		} elsif ($cur =~ /^($Modifier)\s*/) {
			print "MODIFIER($1)\n" if ($dbg_values > 1);
			$type = 'T';

1029
		} elsif ($cur =~ /^(\#\s*define\s*$Ident)(\(?)/o) {
1030
			print "DEFINE($1,$2)\n" if ($dbg_values > 1);
1031
			$av_preprocessor = 1;
1032 1033 1034 1035 1036 1037
			push(@av_paren_type, $type);
			if ($2 ne '') {
				$av_pending = 'N';
			}
			$type = 'E';

1038
		} elsif ($cur =~ /^(\#\s*(?:undef\s*$Ident|include\b))/o) {
1039 1040 1041
			print "UNDEF($1)\n" if ($dbg_values > 1);
			$av_preprocessor = 1;
			push(@av_paren_type, $type);
1042

1043
		} elsif ($cur =~ /^(\#\s*(?:ifdef|ifndef|if))/o) {
1044
			print "PRE_START($1)\n" if ($dbg_values > 1);
1045
			$av_preprocessor = 1;
1046 1047 1048

			push(@av_paren_type, $type);
			push(@av_paren_type, $type);
1049
			$type = 'E';
1050

1051
		} elsif ($cur =~ /^(\#\s*(?:else|elif))/o) {
1052 1053 1054 1055 1056
			print "PRE_RESTART($1)\n" if ($dbg_values > 1);
			$av_preprocessor = 1;

			push(@av_paren_type, $av_paren_type[$#av_paren_type]);

1057
			$type = 'E';
1058

1059
		} elsif ($cur =~ /^(\#\s*(?:endif))/o) {
1060 1061 1062 1063 1064 1065 1066 1067
			print "PRE_END($1)\n" if ($dbg_values > 1);

			$av_preprocessor = 1;

			# Assume all arms of the conditional end as this
			# one does, and continue as if the #endif was not here.
			pop(@av_paren_type);
			push(@av_paren_type, $type);
1068
			$type = 'E';
1069 1070

		} elsif ($cur =~ /^(\\\n)/o) {
1071
			print "PRECONT($1)\n" if ($dbg_values > 1);
1072

1073 1074 1075 1076 1077
		} elsif ($cur =~ /^(__attribute__)\s*\(?/o) {
			print "ATTR($1)\n" if ($dbg_values > 1);
			$av_pending = $type;
			$type = 'N';

1078
		} elsif ($cur =~ /^(sizeof)\s*(\()?/o) {
1079
			print "SIZEOF($1)\n" if ($dbg_values > 1);
1080
			if (defined $2) {
1081
				$av_pending = 'V';
1082 1083 1084
			}
			$type = 'N';

1085
		} elsif ($cur =~ /^(if|while|for)\b/o) {
1086
			print "COND($1)\n" if ($dbg_values > 1);
1087
			$av_pending = 'E';
1088 1089
			$type = 'N';

1090 1091 1092 1093 1094
		} elsif ($cur =~/^(case)/o) {
			print "CASE($1)\n" if ($dbg_values > 1);
			$av_pend_colon = 'C';
			$type = 'N';

1095
		} elsif ($cur =~/^(return|else|goto|typeof|__typeof__)\b/o) {
1096
			print "KEYWORD($1)\n" if ($dbg_values > 1);
1097 1098 1099
			$type = 'N';

		} elsif ($cur =~ /^(\()/o) {
1100
			print "PAREN('$1')\n" if ($dbg_values > 1);
1101 1102
			push(@av_paren_type, $av_pending);
			$av_pending = '_';
1103 1104 1105
			$type = 'N';

		} elsif ($cur =~ /^(\))/o) {
1106 1107 1108
			my $new_type = pop(@av_paren_type);
			if ($new_type ne '_') {
				$type = $new_type;
1109 1110
				print "PAREN('$1') -> $type\n"
							if ($dbg_values > 1);
1111
			} else {
1112
				print "PAREN('$1')\n" if ($dbg_values > 1);
1113 1114
			}

1115
		} elsif ($cur =~ /^($Ident)\s*\(/o) {
1116
			print "FUNC($1)\n" if ($dbg_values > 1);
1117
			$type = 'V';
1118
			$av_pending = 'V';
1119