checkpatch.pl 83.1 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

Andy Whitcroft's avatar
Andy Whitcroft committed
13
my $V = '0.31';
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 $root;
30
my %debug;
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
my $help = 0;

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

66
GetOptions(
67
	'q|quiet+'	=> \$quiet,
68
69
70
	'tree!'		=> \$tree,
	'signoff!'	=> \$chk_signoff,
	'patch!'	=> \$chk_patch,
71
	'emacs!'	=> \$emacs,
72
	'terse!'	=> \$terse,
73
	'f|file!'	=> \$file,
74
75
76
	'subjective!'	=> \$check,
	'strict!'	=> \$check,
	'root=s'	=> \$root,
77
78
	'summary!'	=> \$summary,
	'mailback!'	=> \$mailback,
79
80
	'summary-file!'	=> \$summary_file,

81
	'debug=s'	=> \%debug,
82
	'test-only=s'	=> \$tst_only,
83
84
85
86
87
	'h|help'	=> \$help,
	'version'	=> \$help
) or help(1);

help(0) if ($help);
88
89
90
91

my $exit = 0;

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

96
97
my $dbg_values = 0;
my $dbg_possible = 0;
98
my $dbg_type = 0;
99
my $dbg_attr = 0;
100
for my $key (keys %debug) {
101
102
103
	## no critic
	eval "\${dbg_$key} = '$debug{$key}';";
	die "$@" if ($@);
104
105
}

106
107
my $rpt_cleaners = 0;

108
109
110
111
112
if ($terse) {
	$emacs = 1;
	$quiet++;
}

113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
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);
	}
131
132
}

133
134
my $emitted_corrupt = 0;

135
136
137
138
our $Ident	= qr{
			[A-Za-z_][A-Za-z\d_]*
			(?:\s*\#\#\s*[A-Za-z_][A-Za-z\d_]*)*
		}x;
139
140
141
142
143
144
145
146
our $Storage	= qr{extern|static|asmlinkage};
our $Sparse	= qr{
			__user|
			__kernel|
			__force|
			__iomem|
			__must_check|
			__init_refok|
147
			__kprobes|
148
149
			__ref|
			__rcu
150
		}x;
151
152
153

# Notes to $Attribute:
# We need \b after 'init' otherwise 'initconst' will cause a false positive in a check
154
155
our $Attribute	= qr{
			const|
156
157
158
159
160
161
162
163
164
165
166
167
168
169
			__percpu|
			__nocast|
			__safe|
			__bitwise__|
			__packed__|
			__packed2__|
			__naked|
			__maybe_unused|
			__always_unused|
			__noreturn|
			__used|
			__cold|
			__noclone|
			__deprecated|
170
171
			__read_mostly|
			__kprobes|
172
			__(?:mem|cpu|dev|)(?:initdata|initconst|init\b)|
173
174
			____cacheline_aligned|
			____cacheline_aligned_in_smp|
175
176
			____cacheline_internodealigned_in_smp|
			__weak
177
		  }x;
178
our $Modifier;
179
180
181
182
183
184
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{(?:\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=)};
185
our $Compare    = qr{<=|>=|==|!=|<|>};
186
187
188
our $Operators	= qr{
			<=|>=|==|!=|
			=>|->|<<|>>|<|>|!|~|
189
			&&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|%
190
191
		  }x;

192
193
194
195
our $NonptrType;
our $Type;
our $Declare;

196
197
198
199
200
201
202
203
204
205
206
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;

207
our $typeTypedefs = qr{(?x:
208
	(?:__)?(?:u|s|be|le)(?:8|16|32|64)|
209
210
211
	atomic_t
)};

212
213
our $logFunctions = qr{(?x:
	printk|
214
	[a-z]+_(emerg|alert|crit|err|warning|warn|notice|info|debug|dbg|vdbg|devel|cont|WARN)|
215
	WARN|
216
217
	panic|
	MODULE_[A-Z_]+
218
219
)};

220
221
222
223
224
225
226
227
228
229
our $signature_tags = qr{(?xi:
	Signed-off-by:|
	Acked-by:|
	Tested-by:|
	Reviewed-by:|
	Reported-by:|
	To:|
	Cc:
)};

230
231
our @typeList = (
	qr{void},
232
233
234
235
236
237
238
	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},
239
240
241
242
243
244
245
246
247
248
249
	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},
);
250
251
252
our @modifierList = (
	qr{fastcall},
);
253

254
255
256
257
258
259
our $allowed_asm_includes = qr{(?x:
	irq|
	memory
)};
# memory.h: ARM has a custom one

260
sub build_types {
261
262
	my $mods = "(?x:  \n" . join("|\n  ", @modifierList) . "\n)";
	my $all = "(?x:  \n" . join("|\n  ", @typeList) . "\n)";
263
	$Modifier	= qr{(?:$Attribute|$Sparse|$mods)};
264
	$NonptrType	= qr{
265
			(?:$Modifier\s+|const\s+)*
266
			(?:
267
				(?:typeof|__typeof__)\s*\(\s*\**\s*$Ident\s*\)|
268
				(?:$typeTypedefs\b)|
269
				(?:${all}\b)
270
			)
271
			(?:\s+$Modifier|\s+const)*
272
273
		  }x;
	$Type	= qr{
274
			$NonptrType
275
			(?:[\s\*]+\s*const|[\s\*]+|(?:\s*\[\s*\])+)?
276
			(?:\s+$Inline|\s+$Modifier)*
277
278
279
280
		  }x;
	$Declare	= qr{(?:$Storage\s+)?$Type};
}
build_types();
281

282
283
284
285
286
287
288
289
290
291
292
293
294
295
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;
}

296
297
$chk_signoff = 0 if ($file);

298
299
my @dep_includes = ();
my @dep_functions = ();
300
301
my $removal = "Documentation/feature-removal-schedule.txt";
if ($tree && -f "$root/$removal") {
302
	open(my $REMOVE, '<', "$root/$removal") ||
303
				die "$P: $removal: open failed - $!\n";
304
	while (<$REMOVE>) {
305
306
307
		if (/^Check:\s+(.*\S)/) {
			for my $entry (split(/[, ]+/, $1)) {
				if ($entry =~ m@include/(.*)@) {
308
309
					push(@dep_includes, $1);

310
311
312
				} elsif ($entry !~ m@/@) {
					push(@dep_functions, $entry);
				}
313
			}
314
315
		}
	}
316
	close($REMOVE);
317
318
}

319
my @rawlines = ();
320
321
my @lines = ();
my $vname;
322
for my $filename (@ARGV) {
323
	my $FILE;
324
	if ($file) {
325
		open($FILE, '-|', "diff -u /dev/null $filename") ||
326
			die "$P: $filename: diff failed - $!\n";
327
328
	} elsif ($filename eq '-') {
		open($FILE, '<&STDIN');
329
	} else {
330
		open($FILE, '<', "$filename") ||
331
			die "$P: $filename: open failed - $!\n";
332
	}
333
334
335
336
337
	if ($filename eq '-') {
		$vname = 'Your patch';
	} else {
		$vname = $filename;
	}
338
	while (<$FILE>) {
339
340
341
		chomp;
		push(@rawlines, $_);
	}
342
	close($FILE);
343
	if (!process($filename)) {
344
345
346
		$exit = 1;
	}
	@rawlines = ();
347
	@lines = ();
348
349
350
351
352
}

exit($exit);

sub top_of_kernel_tree {
353
354
355
356
357
358
359
360
361
362
363
364
	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;
		}
365
	}
366
	return 1;
367
368
}

369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
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
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;
}

439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
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;
}
459
sub copy_spacing {
460
	(my $res = shift) =~ tr/\t/ /c;
461
462
	return $res;
}
463

464
465
466
467
468
469
470
471
472
473
474
475
476
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));
}

477
478
479
480
481
482
483
484
485
486
487
my $sanitise_quote = '';

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

	if ($in_comment) {
		$sanitise_quote = '*/';
	} else {
		$sanitise_quote = '';
	}
}
488
489
490
491
492
493
sub sanitise_line {
	my ($line) = @_;

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

494
	my $qlen = 0;
495
496
	my $off = 0;
	my $c;
497

498
499
500
501
502
503
504
505
506
507
508
509
510
511
	# 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;
512
		}
513
		if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') {
514
515
516
517
			$sanitise_quote = '';
			substr($res, $off, 2, "$;$;");
			$off++;
			next;
518
		}
519
520
521
522
523
524
525
		if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') {
			$sanitise_quote = '//';

			substr($res, $off, 2, $sanitise_quote);
			$off++;
			next;
		}
526
527
528
529
530
531
532

		# 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;
533
		}
534
535
536
537
		# Regular quotes.
		if ($c eq "'" || $c eq '"') {
			if ($sanitise_quote eq '') {
				$sanitise_quote = $c;
538

539
540
541
542
543
544
				substr($res, $off, 1, $c);
				next;
			} elsif ($sanitise_quote eq $c) {
				$sanitise_quote = '';
			}
		}
545

546
		#print "c<$c> SQ<$sanitise_quote>\n";
547
548
		if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") {
			substr($res, $off, 1, $;);
549
550
		} elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") {
			substr($res, $off, 1, $;);
551
552
553
554
555
		} elsif ($off != 0 && $sanitise_quote && $c ne "\t") {
			substr($res, $off, 1, 'X');
		} else {
			substr($res, $off, 1, $c);
		}
556
557
	}

558
559
560
561
	if ($sanitise_quote eq '//') {
		$sanitise_quote = '';
	}

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

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

573
574
575
	return $res;
}

576
577
578
579
580
581
sub ctx_statement_block {
	my ($linenr, $remain, $off) = @_;
	my $line = $linenr - 1;
	my $blk = '';
	my $soff = $off;
	my $coff = $off - 1;
582
	my $coff_set = 0;
583

584
585
	my $loff = 0;

586
587
	my $type = '';
	my $level = 0;
588
	my @stack = ();
589
	my $p;
590
591
	my $c;
	my $len = 0;
592
593

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

597
		#warn "CSB: blk<$blk> remain<$remain>\n";
598
599
600
601
		# If we are about to drop off the end, pull in more
		# context.
		if ($off >= $len) {
			for (; $remain > 0; $line++) {
602
				last if (!defined $lines[$line]);
603
				next if ($lines[$line] =~ /^-/);
604
				$remain--;
605
				$loff = $len;
606
				$blk .= $lines[$line] . "\n";
607
608
609
610
611
612
				$len = length($blk);
				$line++;
				last;
			}
			# Bail if there is no further context.
			#warn "CSB: blk<$blk> off<$off> len<$len>\n";
613
			if ($off >= $len) {
614
615
616
				last;
			}
		}
617
		$p = $c;
618
		$c = substr($blk, $off, 1);
619
		$remainder = substr($blk, $off);
620

621
		#warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>\n";
622
623
624
625
626
627
628
629
630
631

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

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

638
		# An else is really a conditional as long as its not else if
639
640
641
642
643
644
645
646
		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";
647
648
		}

649
650
651
652
653
654
655
656
657
658
		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;
659
660
				$coff_set = 1;
				#warn "CSB: mark coff<$coff>\n";
661
662
663
664
665
666
667
668
669
670
671
			}
		}
		if (($type eq '' || $type eq '{') && $c eq '{') {
			$level++;
			$type = '{';
		}
		if ($type eq '{' && $c eq '}') {
			$level--;
			$type = ($level != 0)? '{' : '';

			if ($level == 0) {
672
673
674
				if (substr($blk, $off + 1, 1) eq ';') {
					$off++;
				}
675
676
677
678
679
				last;
			}
		}
		$off++;
	}
680
	# We are truly at the end, so shuffle to the next line.
681
	if ($off == $len) {
682
		$loff = $len + 1;
683
684
685
		$line++;
		$remain--;
	}
686
687
688
689
690
691
692

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

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

693
	#print "coff<$coff> soff<$off> loff<$loff>\n";
694
695
696
697
698

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

699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
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;
	}
}

742
743
744
745
746
747
sub ctx_statement_full {
	my ($linenr, $remain, $off) = @_;
	my ($statement, $condition, $level);

	my (@chunks);

748
	# Grab the first conditional/block pair.
749
750
	($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
751
	#print "F: c<$condition> s<$statement> remain<$remain>\n";
752
753
754
755
756
757
758
	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.
759
760
761
	for (;;) {
		($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
762
		#print "C: c<$condition> s<$statement> remain<$remain>\n";
763
		last if (!($remain > 0 && $condition =~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s));
764
765
		#print "C: push\n";
		push(@chunks, [ $condition, $statement ]);
766
767
768
	}

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

771
sub ctx_block_get {
772
	my ($linenr, $remain, $outer, $open, $close, $off) = @_;
773
774
775
776
777
778
779
	my $line;
	my $start = $linenr - 1;
	my $blk = '';
	my @o;
	my @c;
	my @res = ();

780
	my $level = 0;
781
	my @stack = ($level);
782
783
784
785
786
	for ($line = $start; $remain > 0; $line++) {
		next if ($rawlines[$line] =~ /^-/);
		$remain--;

		$blk .= $rawlines[$line];
787
788

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

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

804
805
806
807
808
809
810
			if ($c eq $close && $level > 0) {
				$level--;
				last if ($level == 0);
			} elsif ($c eq $open) {
				$level++;
			}
		}
811

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

816
		last if ($level == 0);
817
818
	}

819
	return ($level, @res);
820
821
822
823
}
sub ctx_block_outer {
	my ($linenr, $remain) = @_;

824
825
	my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0);
	return @r;
826
827
828
829
}
sub ctx_block {
	my ($linenr, $remain) = @_;

830
831
	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0);
	return @r;
832
833
}
sub ctx_statement {
834
835
836
837
838
839
	my ($linenr, $remain, $off) = @_;

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

842
	return ctx_block_get($linenr, $remain, 0, '{', '}', 0);
843
}
844
845
846
847
848
sub ctx_statement_level {
	my ($linenr, $remain, $off) = @_;

	return ctx_block_get($linenr, $remain, 0, '(', ')', $off);
}
849
850
851
852
853

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

	# Catch a comment on the end of the line itself.
854
	my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@);
855
856
857
858
859
860
861
	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++) {
862
863
		my $line = $rawlines[$linenr - 1];
		#warn "           $line\n";
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
		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);

886
	##print "LINE: $rawlines[$end_line - 1 ]\n";
887
888
889
890
891
	##print "CMMT: $cmt\n";

	return ($cmt ne '');
}

892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
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;
}

908
909
910
sub cat_vet {
	my ($vet) = @_;
	my ($res, $coded);
911

912
913
914
915
916
917
	$res = '';
	while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) {
		$res .= $1;
		if ($2 ne '') {
			$coded = sprintf("^%c", unpack('C', $2) + 64);
			$res .= $coded;
918
919
		}
	}
920
	$res =~ s/$/\$/;
921

922
	return $res;
923
924
}

925
my $av_preprocessor = 0;
926
my $av_pending;
927
my @av_paren_type;
928
my $av_pend_colon;
929
930
931

sub annotate_reset {
	$av_preprocessor = 0;
932
933
	$av_pending = '_';
	@av_paren_type = ('E');
934
	$av_pend_colon = 'O';
935
936
}

937
938
sub annotate_values {
	my ($stream, $type) = @_;
939

940
	my $res;
941
	my $var = '_' x length($stream);
942
943
	my $cur = $stream;

944
	print "$stream\n" if ($dbg_values > 1);
945
946

	while (length($cur)) {
947
		@av_paren_type = ('E') if ($#av_paren_type < 0);
948
		print " <" . join('', @av_paren_type) .
949
				"> <$type> <$av_pending>" if ($dbg_values > 1);
950
		if ($cur =~ /^(\s+)/o) {
951
952
			print "WS($1)\n" if ($dbg_values > 1);
			if ($1 =~ /\n/ && $av_preprocessor) {
953
				$type = pop(@av_paren_type);
954
				$av_preprocessor = 0;
955
956
			}

957
		} elsif ($cur =~ /^(\(\s*$Type\s*)\)/ && $av_pending eq '_') {
958
959
960
961
			print "CAST($1)\n" if ($dbg_values > 1);
			push(@av_paren_type, $type);
			$type = 'C';

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

966
967
968
969
		} elsif ($cur =~ /^($Modifier)\s*/) {
			print "MODIFIER($1)\n" if ($dbg_values > 1);
			$type = 'T';

970
		} elsif ($cur =~ /^(\#\s*define\s*$Ident)(\(?)/o) {
971
			print "DEFINE($1,$2)\n" if ($dbg_values > 1);
972
			$av_preprocessor = 1;
973
974
975
976
977
978
			push(@av_paren_type, $type);
			if ($2 ne '') {
				$av_pending = 'N';
			}
			$type = 'E';

979
		} elsif ($cur =~ /^(\#\s*(?:undef\s*$Ident|include\b))/o) {
980
981
982
			print "UNDEF($1)\n" if ($dbg_values > 1);
			$av_preprocessor = 1;
			push(@av_paren_type, $type);
983

984
		} elsif ($cur =~ /^(\#\s*(?:ifdef|ifndef|if))/o) {
985
			print "PRE_START($1)\n" if ($dbg_values > 1);
986
			$av_preprocessor = 1;
987
988
989

			push(@av_paren_type, $type);
			push(@av_paren_type, $type);
990
			$type = 'E';
991

992
		} elsif ($cur =~ /^(\#\s*(?:else|elif))/o) {
993
994
995
996
997
			print "PRE_RESTART($1)\n" if ($dbg_values > 1);
			$av_preprocessor = 1;

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

998
			$type = 'E';
999

1000
		} elsif ($cur =~ /^(\#\s*(?:endif))/o) {
1001
1002
1003
1004
1005
1006
1007
1008
			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);
1009
			$type = 'E';
1010
1011

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

1014
1015
1016
1017
1018
		} elsif ($cur =~ /^(__attribute__)\s*\(?/o) {
			print "ATTR($1)\n" if ($dbg_values > 1);
			$av_pending = $type;
			$type = 'N';

1019
		} elsif ($cur =~ /^(sizeof)\s*(\()?/o) {
1020
			print "SIZEOF($1)\n" if ($dbg_values > 1);
1021
			if (defined $2) {
1022
				$av_pending = 'V';
1023
1024
1025
			}
			$type = 'N';

1026
		} elsif ($cur =~ /^(if|while|for)\b/o) {
1027
			print "COND($1)\n" if ($dbg_values > 1);
1028
			$av_pending = 'E';
1029
1030
			$type = 'N';

1031
1032
1033
1034
1035
		} elsif ($cur =~/^(case)/o) {
			print "CASE($1)\n" if ($dbg_values > 1);
			$av_pend_colon = 'C';
			$type = 'N';

1036
		} elsif ($cur =~/^(return|else|goto|typeof|__typeof__)\b/o) {
1037
			print "KEYWORD($1)\n" if ($dbg_values > 1);
1038
1039
1040
			$type = 'N';

		} elsif ($cur =~ /^(\()/o) {
1041
			print "PAREN('$1')\n" if ($dbg_values > 1);
1042
1043
			push(@av_paren_type, $av_pending);
			$av_pending = '_';
1044
1045
1046
			$type = 'N';

		} elsif ($cur =~ /^(\))/o) {
1047
1048
1049
			my $new_type = pop(@av_paren_type);
			if ($new_type ne '_') {
				$type = $new_type;
1050
1051
				print "PAREN('$1') -> $type\n"
							if ($dbg_values > 1);
1052
			} else {
1053
				print "PAREN('$1')\n" if ($dbg_values > 1);
1054
1055
			}

1056
		} elsif ($cur =~ /^($Ident)\s*\(/o) {
1057
			print "FUNC($1)\n" if ($dbg_values > 1);
1058
			$type = 'V';
1059
			$av_pending = 'V';
1060

1061
1062
		} elsif ($cur =~ /^($Ident\s*):(?:\s*\d+\s*(,|=|;))?/) {
			if (defined $2 && $type eq 'C' || $type eq 'T') {
1063
				$av_pend_colon = 'B';
1064
1065
			} elsif ($type eq 'E') {
				$av_pend_colon = 'L';
1066
1067
1068
1069
			}
			print "IDENT_COLON($1,$type>$av_pend_colon)\n" if ($dbg_values > 1);
			$type = 'V';

1070
		} elsif ($cur =~ /^($Ident|$Constant)/o) {
1071
			print "IDENT($1)\n" if ($dbg_values > 1);
1072
1073
1074
			$type = 'V';

		} elsif ($cur =~ /^($Assignment)/o) {
1075
			print "ASSIGN($1)\n" if ($dbg_values > 1);
1076
1077
			$type = 'N';

1078
		} elsif ($cur =~/^(;|{|})/) {
1079
			print "END($1)\n" if ($dbg_values > 1);
1080
			$type = 'E';
1081
1082
			$av_pend_colon = 'O';

1083
1084
1085
1086
		} elsif ($cur =~/^(,)/) {
			print "COMMA($1)\n" if ($dbg_values > 1);
			$type = 'C';

1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
		} elsif ($cur =~ /^(\?)/o) {
			print "QUESTION($1)\n" if ($dbg_values > 1);
			$type = 'N';

		} elsif ($cur =~ /^(:)/o) {
			print "COLON($1,$av_pend_colon)\n" if ($dbg_values > 1);

			substr($var, length($res), 1, $av_pend_colon);
			if ($av_pend_colon eq 'C' || $av_pend_colon eq 'L') {
				$type = 'E';
			} else {
				$type = 'N';
			}
			$av_pend_colon = 'O';
1101

1102
		} elsif ($cur =~ /^(\[)/o) {
1103
			print "CLOSE($1)\n" if ($dbg_values > 1);
1104
1105
			$type = 'N';

1106
		} elsif ($cur =~ /^(-(?![->])|\+(?!\+)|\*|\&\&|\&)/o) {
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
			my $variant;

			print "OPV($1)\n" if ($dbg_values > 1);
			if ($type eq 'V') {
				$variant = 'B';
			} else {
				$variant = 'U';
			}

			substr($var, length($res), 1, $variant);
			$type = 'N';

1119
		} elsif ($cur =~ /^($Operators)/o) {
1120
			print "OP($1)\n" if ($dbg_values > 1);
1121
1122
1123
1124
1125
			if ($1 ne '++' && $1 ne '--') {
				$type = 'N';
			}

		} elsif ($cur =~ /(^.)/o) {
1126
			print "C($1)\n" if ($dbg_values > 1);
1127
1128
1129
1130
1131
		}
		if (defined $1) {
			$cur = substr($cur, length($1));
			$res .= $type x length($1);
		}
1132
	}
1133

1134
	return ($res, $var);
1135
1136
}

1137
sub possible {
1138
	my ($possible, $line) = @_;
1139
	my $notPermitted = qr{(?:
1140
1141
1142
1143
		^(?:
			$Modifier|
			$Storage|
			$Type|
1144
1145
1146
			DEFINE_\S+
		)$|
		^(?:
1147
1148
1149
1150
1151
1152
			goto|
			return|
			case|
			else|
			asm|__asm__|
			do
1153
		)(?:\s|$)|
1154
		^(?:typedef|struct|enum)\b
1155
1156
1157
	    )}x;
	warn "CHECK<$possible> ($line)\n" if ($dbg_possible > 2);
	if ($possible !~ $notPermitted) {
1158
1159
1160
1161
1162
1163
1164
		# Check for modifiers.
		$possible =~ s/\s*$Storage\s*//g;
		$possible =~ s/\s*$Sparse\s*//g;
		if ($possible =~ /^\s*$/) {

		} elsif ($possible =~ /\s/) {
			$possible =~ s/\s*$Type\s*//g;
1165
			for my $modifier (split(' ', $possible)) {
1166
1167
1168
1169
				if ($modifier !~ $notPermitted) {
					warn "MODIFIER: $modifier ($possible) ($line)\n" if ($dbg_possible);
					push(@modifierList, $modifier);
				}
1170
			}
1171
1172
1173
1174
1175

		} else {
			warn "POSSIBLE: $possible ($line)\n" if ($dbg_possible);
			push(@typeList, $possible);
		}
1176
		build_types();
1177
1178
	} else {
		warn "NOTPOSS: $possible ($line)\n" if ($dbg_possible > 1);
1179
1180
1181
	}
}

1182
1183
my $prefix = '';

1184
sub report {
1185
1186
1187
	if (defined $tst_only && $_[0] !~ /\Q$tst_only\E/) {
		return 0;
	}
1188
1189
1190
1191
	my $line = $prefix . $_[0];

	$line = (split('\n', $line))[0] . "\n" if ($terse);

1192
	push(our @report, $line);
1193
1194

	return 1;
1195
1196