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
148
			__kprobes|
			__ref
149
		}x;
150
151
152

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

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

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

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

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

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

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

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

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

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

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

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

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

exit($exit);

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

492
493
494
	return $res;
}

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

503
504
	my $loff = 0;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	my (@chunks);

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	return ($cmt ne '');
}

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

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

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

841
	return $res;
842
843
}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

917
			$type = 'E';
918

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1101
1102
my $prefix = '';

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

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

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

	return 1;
1114
1115
}
sub report_dump {
1116
	our @report;
1117
}
1118
sub ERROR {
1119
1120
1121
1122
	if (report("ERROR: $_[0]\n")) {
		our $clean = 0;
		our $cnt_error++;
	}
1123
1124
}
sub WARN {
1125
1126
1127
1128
	if (report("WARNING: $_[0]\n")) {
		our $clean = 0;
		our $cnt_warn++;
	}
1129
1130
}
sub CHK {
1131
	if ($check && report("CHECK: $_[0]\n")) {
1132
1133
1134
		our $clean = 0;
		our $cnt_chk++;
	}
1135
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
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 $prefix = $absolute;
	substr($prefix, -length($file)) = '';

	##print "prefix<$prefix>\n";
	if ($prefix ne ".../") {
		WARN("use relative pathname instead of absolute in changelog text\n" . $herecurr);
	}
}