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

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
our @typeList = (
	qr{void},
222
223
224
225
226
227
228
	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},
229
230
231
232
233
234
235
236
237
238
239
	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},
);
240
241
242
our @modifierList = (
	qr{fastcall},
);
243

244
245
246
247
248
249
our $allowed_asm_includes = qr{(?x:
	irq|
	memory
)};
# memory.h: ARM has a custom one

250
sub build_types {
251
252
	my $mods = "(?x:  \n" . join("|\n  ", @modifierList) . "\n)";
	my $all = "(?x:  \n" . join("|\n  ", @typeList) . "\n)";
253
	$Modifier	= qr{(?:$Attribute|$Sparse|$mods)};
254
	$NonptrType	= qr{
255
			(?:$Modifier\s+|const\s+)*
256
			(?:
257
				(?:typeof|__typeof__)\s*\(\s*\**\s*$Ident\s*\)|
258
				(?:$typeTypedefs\b)|
259
				(?:${all}\b)
260
			)
261
			(?:\s+$Modifier|\s+const)*
262
263
		  }x;
	$Type	= qr{
264
			$NonptrType
265
			(?:[\s\*]+\s*const|[\s\*]+|(?:\s*\[\s*\])+)?
266
			(?:\s+$Inline|\s+$Modifier)*
267
268
269
270
		  }x;
	$Declare	= qr{(?:$Storage\s+)?$Type};
}
build_types();
271

272
273
274
275
276
277
278
279
280
281
282
283
284
285
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;
}

286
287
$chk_signoff = 0 if ($file);

288
289
my @dep_includes = ();
my @dep_functions = ();
290
291
my $removal = "Documentation/feature-removal-schedule.txt";
if ($tree && -f "$root/$removal") {
292
	open(my $REMOVE, '<', "$root/$removal") ||
293
				die "$P: $removal: open failed - $!\n";
294
	while (<$REMOVE>) {
295
296
297
		if (/^Check:\s+(.*\S)/) {
			for my $entry (split(/[, ]+/, $1)) {
				if ($entry =~ m@include/(.*)@) {
298
299
					push(@dep_includes, $1);

300
301
302
				} elsif ($entry !~ m@/@) {
					push(@dep_functions, $entry);
				}
303
			}
304
305
		}
	}
306
	close($REMOVE);
307
308
}

309
my @rawlines = ();
310
311
my @lines = ();
my $vname;
312
for my $filename (@ARGV) {
313
	my $FILE;
314
	if ($file) {
315
		open($FILE, '-|', "diff -u /dev/null $filename") ||
316
			die "$P: $filename: diff failed - $!\n";
317
318
	} elsif ($filename eq '-') {
		open($FILE, '<&STDIN');
319
	} else {
320
		open($FILE, '<', "$filename") ||
321
			die "$P: $filename: open failed - $!\n";
322
	}
323
324
325
326
327
	if ($filename eq '-') {
		$vname = 'Your patch';
	} else {
		$vname = $filename;
	}
328
	while (<$FILE>) {
329
330
331
		chomp;
		push(@rawlines, $_);
	}
332
	close($FILE);
333
	if (!process($filename)) {
334
335
336
		$exit = 1;
	}
	@rawlines = ();
337
	@lines = ();
338
339
340
341
342
}

exit($exit);

sub top_of_kernel_tree {
343
344
345
346
347
348
349
350
351
352
353
354
	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;
		}
355
	}
356
	return 1;
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
}

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;
}
379
sub copy_spacing {
380
	(my $res = shift) =~ tr/\t/ /c;
381
382
	return $res;
}
383

384
385
386
387
388
389
390
391
392
393
394
395
396
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));
}

397
398
399
400
401
402
403
404
405
406
407
my $sanitise_quote = '';

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

	if ($in_comment) {
		$sanitise_quote = '*/';
	} else {
		$sanitise_quote = '';
	}
}
408
409
410
411
412
413
sub sanitise_line {
	my ($line) = @_;

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

414
	my $qlen = 0;
415
416
	my $off = 0;
	my $c;
417

418
419
420
421
422
423
424
425
426
427
428
429
430
431
	# 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;
432
		}
433
		if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') {
434
435
436
437
			$sanitise_quote = '';
			substr($res, $off, 2, "$;$;");
			$off++;
			next;
438
		}
439
440
441
442
443
444
445
		if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') {
			$sanitise_quote = '//';

			substr($res, $off, 2, $sanitise_quote);
			$off++;
			next;
		}
446
447
448
449
450
451
452

		# 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;
453
		}
454
455
456
457
		# Regular quotes.
		if ($c eq "'" || $c eq '"') {
			if ($sanitise_quote eq '') {
				$sanitise_quote = $c;
458

459
460
461
462
463
464
				substr($res, $off, 1, $c);
				next;
			} elsif ($sanitise_quote eq $c) {
				$sanitise_quote = '';
			}
		}
465

466
		#print "c<$c> SQ<$sanitise_quote>\n";
467
468
		if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") {
			substr($res, $off, 1, $;);
469
470
		} elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") {
			substr($res, $off, 1, $;);
471
472
473
474
475
		} elsif ($off != 0 && $sanitise_quote && $c ne "\t") {
			substr($res, $off, 1, 'X');
		} else {
			substr($res, $off, 1, $c);
		}
476
477
	}

478
479
480
481
	if ($sanitise_quote eq '//') {
		$sanitise_quote = '';
	}

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

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

493
494
495
	return $res;
}

496
497
498
499
500
501
sub ctx_statement_block {
	my ($linenr, $remain, $off) = @_;
	my $line = $linenr - 1;
	my $blk = '';
	my $soff = $off;
	my $coff = $off - 1;
502
	my $coff_set = 0;
503

504
505
	my $loff = 0;

506
507
	my $type = '';
	my $level = 0;
508
	my @stack = ();
509
	my $p;
510
511
	my $c;
	my $len = 0;
512
513

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

517
		#warn "CSB: blk<$blk> remain<$remain>\n";
518
519
520
521
		# If we are about to drop off the end, pull in more
		# context.
		if ($off >= $len) {
			for (; $remain > 0; $line++) {
522
				last if (!defined $lines[$line]);
523
				next if ($lines[$line] =~ /^-/);
524
				$remain--;
525
				$loff = $len;
526
				$blk .= $lines[$line] . "\n";
527
528
529
530
531
532
				$len = length($blk);
				$line++;
				last;
			}
			# Bail if there is no further context.
			#warn "CSB: blk<$blk> off<$off> len<$len>\n";
533
			if ($off >= $len) {
534
535
536
				last;
			}
		}
537
		$p = $c;
538
		$c = substr($blk, $off, 1);
539
		$remainder = substr($blk, $off);
540

541
		#warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>\n";
542
543
544
545
546
547
548
549
550
551

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

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

558
		# An else is really a conditional as long as its not else if
559
560
561
562
563
564
565
566
		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";
567
568
		}

569
570
571
572
573
574
575
576
577
578
		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;
579
580
				$coff_set = 1;
				#warn "CSB: mark coff<$coff>\n";
581
582
583
584
585
586
587
588
589
590
591
			}
		}
		if (($type eq '' || $type eq '{') && $c eq '{') {
			$level++;
			$type = '{';
		}
		if ($type eq '{' && $c eq '}') {
			$level--;
			$type = ($level != 0)? '{' : '';

			if ($level == 0) {
592
593
594
				if (substr($blk, $off + 1, 1) eq ';') {
					$off++;
				}
595
596
597
598
599
				last;
			}
		}
		$off++;
	}
600
	# We are truly at the end, so shuffle to the next line.
601
	if ($off == $len) {
602
		$loff = $len + 1;
603
604
605
		$line++;
		$remain--;
	}
606
607
608
609
610
611
612

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

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

613
	#print "coff<$coff> soff<$off> loff<$loff>\n";
614
615
616
617
618

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

619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
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;
	}
}

662
663
664
665
666
667
sub ctx_statement_full {
	my ($linenr, $remain, $off) = @_;
	my ($statement, $condition, $level);

	my (@chunks);

668
	# Grab the first conditional/block pair.
669
670
	($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
671
	#print "F: c<$condition> s<$statement> remain<$remain>\n";
672
673
674
675
676
677
678
	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.
679
680
681
	for (;;) {
		($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
682
		#print "C: c<$condition> s<$statement> remain<$remain>\n";
683
		last if (!($remain > 0 && $condition =~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s));
684
685
		#print "C: push\n";
		push(@chunks, [ $condition, $statement ]);
686
687
688
	}

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

691
sub ctx_block_get {
692
	my ($linenr, $remain, $outer, $open, $close, $off) = @_;
693
694
695
696
697
698
699
	my $line;
	my $start = $linenr - 1;
	my $blk = '';
	my @o;
	my @c;
	my @res = ();

700
	my $level = 0;
701
	my @stack = ($level);
702
703
704
705
706
	for ($line = $start; $remain > 0; $line++) {
		next if ($rawlines[$line] =~ /^-/);
		$remain--;

		$blk .= $rawlines[$line];
707
708

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

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

724
725
726
727
728
729
730
			if ($c eq $close && $level > 0) {
				$level--;
				last if ($level == 0);
			} elsif ($c eq $open) {
				$level++;
			}
		}
731

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

736
		last if ($level == 0);
737
738
	}

739
	return ($level, @res);
740
741
742
743
}
sub ctx_block_outer {
	my ($linenr, $remain) = @_;

744
745
	my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0);
	return @r;
746
747
748
749
}
sub ctx_block {
	my ($linenr, $remain) = @_;

750
751
	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0);
	return @r;
752
753
}
sub ctx_statement {
754
755
756
757
758
759
	my ($linenr, $remain, $off) = @_;

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

762
	return ctx_block_get($linenr, $remain, 0, '{', '}', 0);
763
}
764
765
766
767
768
sub ctx_statement_level {
	my ($linenr, $remain, $off) = @_;

	return ctx_block_get($linenr, $remain, 0, '(', ')', $off);
}
769
770
771
772
773

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

	# Catch a comment on the end of the line itself.
774
	my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@);
775
776
777
778
779
780
781
	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++) {
782
783
		my $line = $rawlines[$linenr - 1];
		#warn "           $line\n";
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
		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);

806
	##print "LINE: $rawlines[$end_line - 1 ]\n";
807
808
809
810
811
	##print "CMMT: $cmt\n";

	return ($cmt ne '');
}

812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
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;
}

828
829
830
sub cat_vet {
	my ($vet) = @_;
	my ($res, $coded);
831

832
833
834
835
836
837
	$res = '';
	while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) {
		$res .= $1;
		if ($2 ne '') {
			$coded = sprintf("^%c", unpack('C', $2) + 64);
			$res .= $coded;
838
839
		}
	}
840
	$res =~ s/$/\$/;
841

842
	return $res;
843
844
}

845
my $av_preprocessor = 0;
846
my $av_pending;
847
my @av_paren_type;
848
my $av_pend_colon;
849
850
851

sub annotate_reset {
	$av_preprocessor = 0;
852
853
	$av_pending = '_';
	@av_paren_type = ('E');
854
	$av_pend_colon = 'O';
855
856
}

857
858
sub annotate_values {
	my ($stream, $type) = @_;
859

860
	my $res;
861
	my $var = '_' x length($stream);
862
863
	my $cur = $stream;

864
	print "$stream\n" if ($dbg_values > 1);
865
866

	while (length($cur)) {
867
		@av_paren_type = ('E') if ($#av_paren_type < 0);
868
		print " <" . join('', @av_paren_type) .
869
				"> <$type> <$av_pending>" if ($dbg_values > 1);
870
		if ($cur =~ /^(\s+)/o) {
871
872
			print "WS($1)\n" if ($dbg_values > 1);
			if ($1 =~ /\n/ && $av_preprocessor) {
873
				$type = pop(@av_paren_type);
874
				$av_preprocessor = 0;
875
876
			}

877
		} elsif ($cur =~ /^(\(\s*$Type\s*)\)/ && $av_pending eq '_') {
878
879
880
881
			print "CAST($1)\n" if ($dbg_values > 1);
			push(@av_paren_type, $type);
			$type = 'C';

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

886
887
888
889
		} elsif ($cur =~ /^($Modifier)\s*/) {
			print "MODIFIER($1)\n" if ($dbg_values > 1);
			$type = 'T';

890
		} elsif ($cur =~ /^(\#\s*define\s*$Ident)(\(?)/o) {
891
			print "DEFINE($1,$2)\n" if ($dbg_values > 1);
892
			$av_preprocessor = 1;
893
894
895
896
897
898
			push(@av_paren_type, $type);
			if ($2 ne '') {
				$av_pending = 'N';
			}
			$type = 'E';

899
		} elsif ($cur =~ /^(\#\s*(?:undef\s*$Ident|include\b))/o) {
900
901
902
			print "UNDEF($1)\n" if ($dbg_values > 1);
			$av_preprocessor = 1;
			push(@av_paren_type, $type);
903

904
		} elsif ($cur =~ /^(\#\s*(?:ifdef|ifndef|if))/o) {
905
			print "PRE_START($1)\n" if ($dbg_values > 1);
906
			$av_preprocessor = 1;
907
908
909

			push(@av_paren_type, $type);
			push(@av_paren_type, $type);
910
			$type = 'E';
911

912
		} elsif ($cur =~ /^(\#\s*(?:else|elif))/o) {
913
914
915
916
917
			print "PRE_RESTART($1)\n" if ($dbg_values > 1);
			$av_preprocessor = 1;

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

918
			$type = 'E';
919

920
		} elsif ($cur =~ /^(\#\s*(?:endif))/o) {
921
922
923
924
925
926
927
928
			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);
929
			$type = 'E';
930
931

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

934
935
936
937
938
		} elsif ($cur =~ /^(__attribute__)\s*\(?/o) {
			print "ATTR($1)\n" if ($dbg_values > 1);
			$av_pending = $type;
			$type = 'N';

939
		} elsif ($cur =~ /^(sizeof)\s*(\()?/o) {
940
			print "SIZEOF($1)\n" if ($dbg_values > 1);
941
			if (defined $2) {
942
				$av_pending = 'V';
943
944
945
			}
			$type = 'N';

946
		} elsif ($cur =~ /^(if|while|for)\b/o) {
947
			print "COND($1)\n" if ($dbg_values > 1);
948
			$av_pending = 'E';
949
950
			$type = 'N';

951
952
953
954
955
		} elsif ($cur =~/^(case)/o) {
			print "CASE($1)\n" if ($dbg_values > 1);
			$av_pend_colon = 'C';
			$type = 'N';

956
		} elsif ($cur =~/^(return|else|goto|typeof|__typeof__)\b/o) {
957
			print "KEYWORD($1)\n" if ($dbg_values > 1);
958
959
960
			$type = 'N';

		} elsif ($cur =~ /^(\()/o) {
961
			print "PAREN('$1')\n" if ($dbg_values > 1);
962
963
			push(@av_paren_type, $av_pending);
			$av_pending = '_';
964
965
966
			$type = 'N';

		} elsif ($cur =~ /^(\))/o) {
967
968
969
			my $new_type = pop(@av_paren_type);
			if ($new_type ne '_') {
				$type = $new_type;
970
971
				print "PAREN('$1') -> $type\n"
							if ($dbg_values > 1);
972
			} else {
973
				print "PAREN('$1')\n" if ($dbg_values > 1);
974
975
			}

976
		} elsif ($cur =~ /^($Ident)\s*\(/o) {
977
			print "FUNC($1)\n" if ($dbg_values > 1);
978
			$type = 'V';
979
			$av_pending = 'V';
980

981
982
		} elsif ($cur =~ /^($Ident\s*):(?:\s*\d+\s*(,|=|;))?/) {
			if (defined $2 && $type eq 'C' || $type eq 'T') {
983
				$av_pend_colon = 'B';
984
985
			} elsif ($type eq 'E') {
				$av_pend_colon = 'L';
986
987
988
989
			}
			print "IDENT_COLON($1,$type>$av_pend_colon)\n" if ($dbg_values > 1);
			$type = 'V';

990
		} elsif ($cur =~ /^($Ident|$Constant)/o) {
991
			print "IDENT($1)\n" if ($dbg_values > 1);
992
993
994
			$type = 'V';

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

998
		} elsif ($cur =~/^(;|{|})/) {
999
			print "END($1)\n" if ($dbg_values > 1);
1000
			$type = 'E';
1001
1002
			$av_pend_colon = 'O';

1003
1004
1005
1006
		} elsif ($cur =~/^(,)/) {
			print "COMMA($1)\n" if ($dbg_values > 1);
			$type = 'C';

1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
		} 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';
1021

1022
		} elsif ($cur =~ /^(\[)/o) {
1023
			print "CLOSE($1)\n" if ($dbg_values > 1);
1024
1025
			$type = 'N';

1026
		} elsif ($cur =~ /^(-(?![->])|\+(?!\+)|\*|\&\&|\&)/o) {
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
			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';

1039
		} elsif ($cur =~ /^($Operators)/o) {
1040
			print "OP($1)\n" if ($dbg_values > 1);
1041
1042
1043
1044
1045
			if ($1 ne '++' && $1 ne '--') {
				$type = 'N';
			}

		} elsif ($cur =~ /(^.)/o) {
1046
			print "C($1)\n" if ($dbg_values > 1);
1047
1048
1049
1050
1051
		}
		if (defined $1) {
			$cur = substr($cur, length($1));
			$res .= $type x length($1);
		}
1052
	}
1053

1054
	return ($res, $var);
1055
1056
}

1057
sub possible {
1058
	my ($possible, $line) = @_;
1059
	my $notPermitted = qr{(?:
1060
1061
1062
1063
		^(?:
			$Modifier|
			$Storage|
			$Type|
1064
1065
1066
			DEFINE_\S+
		)$|
		^(?:
1067
1068
1069
1070
1071
1072
			goto|
			return|
			case|
			else|
			asm|__asm__|
			do
1073
		)(?:\s|$)|
1074
		^(?:typedef|struct|enum)\b
1075
1076
1077
	    )}x;
	warn "CHECK<$possible> ($line)\n" if ($dbg_possible > 2);
	if ($possible !~ $notPermitted) {
1078
1079
1080
1081
1082
1083
1084
		# 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;
1085
			for my $modifier (split(' ', $possible)) {
1086
1087
1088
1089
				if ($modifier !~ $notPermitted) {
					warn "MODIFIER: $modifier ($possible) ($line)\n" if ($dbg_possible);
					push(@modifierList, $modifier);
				}
1090
			}
1091
1092
1093
1094
1095

		} else {
			warn "POSSIBLE: $possible ($line)\n" if ($dbg_possible);
			push(@typeList, $possible);
		}
1096
		build_types();
1097
1098
	} else {
		warn "NOTPOSS: $possible ($line)\n" if ($dbg_possible > 1);
1099
1100
1101
	}
}

1102
1103
my $prefix = '';

1104
sub report {
1105
1106
1107
	if (defined $tst_only && $_[0] !~ /\Q$tst_only\E/) {
		return 0;
	}
1108
1109
1110
1111
	my $line = $prefix . $_[0];

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

1112
	push(our @report, $line);
1113
1114

	return 1;
1115
1116
}
sub report_dump {
1117
	our @report;
1118
}
1119
sub ERROR {
1120
1121
1122
1123
	if (report("ERROR: $_[0]\n")) {
		our $clean = 0;
		our $cnt_error++;
	}
1124
1125
}
sub WARN {
1126
1127
1128
1129
	if (report("WARNING: $_[0]\n")) {
		our $clean = 0;
		our $cnt_warn++;
	}
1130
1131
}
sub CHK {
1132
	if ($check && report("CHECK: $_[0]\n")) {
1133
1134
1135
		our $clean = 0;
		our $cnt_chk++;
	}
1136
1137
}

1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
sub check_absolute_file {
	my ($absolute, $herecurr) = @_;
	my $file = $absolute;

	##print "absolute<$absolute>\n";

	# See if any suffix of this path is a path within the tree.
	while ($file =~ s@^[^/]*/@@) {
		if (-f "$root/$file") {
			##print "file<$file>\n";
			last;
		}
	}
	if (! -f _)  {
		return 0;
	}

	# It is, so see if the prefix is acceptable.
	my