checkpatch.pl 76 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,2009, 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.30';
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
155
156
our $Attribute	= qr{
			const|
			__read_mostly|
			__kprobes|
157
			__(?:mem|cpu|dev|)(?:initdata|initconst|init\b)|
158
159
			____cacheline_aligned|
			____cacheline_aligned_in_smp|
160
161
			____cacheline_internodealigned_in_smp|
			__weak
162
		  }x;
163
our $Modifier;
164
165
166
167
168
169
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{(?:\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=)};
170
our $Compare    = qr{<=|>=|==|!=|<|>};
171
172
173
our $Operators	= qr{
			<=|>=|==|!=|
			=>|->|<<|>>|<|>|!|~|
174
			&&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|%
175
176
		  }x;

177
178
179
180
our $NonptrType;
our $Type;
our $Declare;

181
182
183
184
185
186
187
188
189
190
191
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;

192
our $typeTypedefs = qr{(?x:
193
	(?:__)?(?:u|s|be|le)(?:8|16|32|64)|
194
195
196
	atomic_t
)};

197
198
199
our $logFunctions = qr{(?x:
	printk|
	pr_(debug|dbg|vdbg|devel|info|warning|err|notice|alert|crit|emerg|cont)|
200
	(dev|netdev|netif)_(printk|dbg|vdbg|info|warn|err|notice|alert|crit|emerg|WARN)|
201
202
203
204
	WARN|
	panic
)};

205
206
our @typeList = (
	qr{void},
207
208
209
210
211
212
213
	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},
214
215
216
217
218
219
220
221
222
223
224
	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},
);
225
226
227
our @modifierList = (
	qr{fastcall},
);
228

229
230
231
232
233
234
our $allowed_asm_includes = qr{(?x:
	irq|
	memory
)};
# memory.h: ARM has a custom one

235
sub build_types {
236
237
	my $mods = "(?x:  \n" . join("|\n  ", @modifierList) . "\n)";
	my $all = "(?x:  \n" . join("|\n  ", @typeList) . "\n)";
238
	$Modifier	= qr{(?:$Attribute|$Sparse|$mods)};
239
	$NonptrType	= qr{
240
			(?:$Modifier\s+|const\s+)*
241
			(?:
242
				(?:typeof|__typeof__)\s*\(\s*\**\s*$Ident\s*\)|
243
				(?:$typeTypedefs\b)|
244
				(?:${all}\b)
245
			)
246
			(?:\s+$Modifier|\s+const)*
247
248
		  }x;
	$Type	= qr{
249
			$NonptrType
250
			(?:[\s\*]+\s*const|[\s\*]+|(?:\s*\[\s*\])+)?
251
			(?:\s+$Inline|\s+$Modifier)*
252
253
254
255
		  }x;
	$Declare	= qr{(?:$Storage\s+)?$Type};
}
build_types();
256
257
258

$chk_signoff = 0 if ($file);

259
260
my @dep_includes = ();
my @dep_functions = ();
261
262
my $removal = "Documentation/feature-removal-schedule.txt";
if ($tree && -f "$root/$removal") {
263
	open(my $REMOVE, '<', "$root/$removal") ||
264
				die "$P: $removal: open failed - $!\n";
265
	while (<$REMOVE>) {
266
267
268
		if (/^Check:\s+(.*\S)/) {
			for my $entry (split(/[, ]+/, $1)) {
				if ($entry =~ m@include/(.*)@) {
269
270
					push(@dep_includes, $1);

271
272
273
				} elsif ($entry !~ m@/@) {
					push(@dep_functions, $entry);
				}
274
			}
275
276
		}
	}
277
	close($REMOVE);
278
279
}

280
my @rawlines = ();
281
282
my @lines = ();
my $vname;
283
for my $filename (@ARGV) {
284
	my $FILE;
285
	if ($file) {
286
		open($FILE, '-|', "diff -u /dev/null $filename") ||
287
			die "$P: $filename: diff failed - $!\n";
288
289
	} elsif ($filename eq '-') {
		open($FILE, '<&STDIN');
290
	} else {
291
		open($FILE, '<', "$filename") ||
292
			die "$P: $filename: open failed - $!\n";
293
	}
294
295
296
297
298
	if ($filename eq '-') {
		$vname = 'Your patch';
	} else {
		$vname = $filename;
	}
299
	while (<$FILE>) {
300
301
302
		chomp;
		push(@rawlines, $_);
	}
303
	close($FILE);
304
	if (!process($filename)) {
305
306
307
		$exit = 1;
	}
	@rawlines = ();
308
	@lines = ();
309
310
311
312
313
}

exit($exit);

sub top_of_kernel_tree {
314
315
316
317
318
319
320
321
322
323
324
325
	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;
		}
326
	}
327
	return 1;
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
}

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;
}
350
sub copy_spacing {
351
	(my $res = shift) =~ tr/\t/ /c;
352
353
	return $res;
}
354

355
356
357
358
359
360
361
362
363
364
365
366
367
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));
}

368
369
370
371
372
373
374
375
376
377
378
my $sanitise_quote = '';

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

	if ($in_comment) {
		$sanitise_quote = '*/';
	} else {
		$sanitise_quote = '';
	}
}
379
380
381
382
383
384
sub sanitise_line {
	my ($line) = @_;

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

385
	my $qlen = 0;
386
387
	my $off = 0;
	my $c;
388

389
390
391
392
393
394
395
396
397
398
399
400
401
402
	# 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;
403
		}
404
		if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') {
405
406
407
408
			$sanitise_quote = '';
			substr($res, $off, 2, "$;$;");
			$off++;
			next;
409
		}
410
411
412
413
414
415
416
		if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') {
			$sanitise_quote = '//';

			substr($res, $off, 2, $sanitise_quote);
			$off++;
			next;
		}
417
418
419
420
421
422
423

		# 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;
424
		}
425
426
427
428
		# Regular quotes.
		if ($c eq "'" || $c eq '"') {
			if ($sanitise_quote eq '') {
				$sanitise_quote = $c;
429

430
431
432
433
434
435
				substr($res, $off, 1, $c);
				next;
			} elsif ($sanitise_quote eq $c) {
				$sanitise_quote = '';
			}
		}
436

437
		#print "c<$c> SQ<$sanitise_quote>\n";
438
439
		if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") {
			substr($res, $off, 1, $;);
440
441
		} elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") {
			substr($res, $off, 1, $;);
442
443
444
445
446
		} elsif ($off != 0 && $sanitise_quote && $c ne "\t") {
			substr($res, $off, 1, 'X');
		} else {
			substr($res, $off, 1, $c);
		}
447
448
	}

449
450
451
452
	if ($sanitise_quote eq '//') {
		$sanitise_quote = '';
	}

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

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

464
465
466
	return $res;
}

467
468
469
470
471
472
sub ctx_statement_block {
	my ($linenr, $remain, $off) = @_;
	my $line = $linenr - 1;
	my $blk = '';
	my $soff = $off;
	my $coff = $off - 1;
473
	my $coff_set = 0;
474

475
476
	my $loff = 0;

477
478
	my $type = '';
	my $level = 0;
479
	my @stack = ();
480
	my $p;
481
482
	my $c;
	my $len = 0;
483
484

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

488
		#warn "CSB: blk<$blk> remain<$remain>\n";
489
490
491
492
		# If we are about to drop off the end, pull in more
		# context.
		if ($off >= $len) {
			for (; $remain > 0; $line++) {
493
				last if (!defined $lines[$line]);
494
				next if ($lines[$line] =~ /^-/);
495
				$remain--;
496
				$loff = $len;
497
				$blk .= $lines[$line] . "\n";
498
499
500
501
502
503
				$len = length($blk);
				$line++;
				last;
			}
			# Bail if there is no further context.
			#warn "CSB: blk<$blk> off<$off> len<$len>\n";
504
			if ($off >= $len) {
505
506
507
				last;
			}
		}
508
		$p = $c;
509
		$c = substr($blk, $off, 1);
510
		$remainder = substr($blk, $off);
511

512
		#warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>\n";
513
514
515
516
517
518
519
520
521
522

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

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

529
		# An else is really a conditional as long as its not else if
530
531
532
533
534
535
536
537
		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";
538
539
		}

540
541
542
543
544
545
546
547
548
549
		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;
550
551
				$coff_set = 1;
				#warn "CSB: mark coff<$coff>\n";
552
553
554
555
556
557
558
559
560
561
562
			}
		}
		if (($type eq '' || $type eq '{') && $c eq '{') {
			$level++;
			$type = '{';
		}
		if ($type eq '{' && $c eq '}') {
			$level--;
			$type = ($level != 0)? '{' : '';

			if ($level == 0) {
563
564
565
				if (substr($blk, $off + 1, 1) eq ';') {
					$off++;
				}
566
567
568
569
570
				last;
			}
		}
		$off++;
	}
571
	# We are truly at the end, so shuffle to the next line.
572
	if ($off == $len) {
573
		$loff = $len + 1;
574
575
576
		$line++;
		$remain--;
	}
577
578
579
580
581
582
583

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

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

584
	#print "coff<$coff> soff<$off> loff<$loff>\n";
585
586
587
588
589

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

590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
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;
	}
}

633
634
635
636
637
638
sub ctx_statement_full {
	my ($linenr, $remain, $off) = @_;
	my ($statement, $condition, $level);

	my (@chunks);

639
	# Grab the first conditional/block pair.
640
641
	($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
642
	#print "F: c<$condition> s<$statement> remain<$remain>\n";
643
644
645
646
647
648
649
	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.
650
651
652
	for (;;) {
		($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
653
		#print "C: c<$condition> s<$statement> remain<$remain>\n";
654
		last if (!($remain > 0 && $condition =~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s));
655
656
		#print "C: push\n";
		push(@chunks, [ $condition, $statement ]);
657
658
659
	}

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

662
sub ctx_block_get {
663
	my ($linenr, $remain, $outer, $open, $close, $off) = @_;
664
665
666
667
668
669
670
	my $line;
	my $start = $linenr - 1;
	my $blk = '';
	my @o;
	my @c;
	my @res = ();

671
	my $level = 0;
672
	my @stack = ($level);
673
674
675
676
677
	for ($line = $start; $remain > 0; $line++) {
		next if ($rawlines[$line] =~ /^-/);
		$remain--;

		$blk .= $rawlines[$line];
678
679
680
681
682
683
684
685
686
687

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

688
689
690
691
692
693
		foreach my $c (split(//, $rawlines[$line])) {
			##print "C<$c>L<$level><$open$close>O<$off>\n";
			if ($off > 0) {
				$off--;
				next;
			}
694

695
696
697
698
699
700
701
			if ($c eq $close && $level > 0) {
				$level--;
				last if ($level == 0);
			} elsif ($c eq $open) {
				$level++;
			}
		}
702

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

707
		last if ($level == 0);
708
709
	}

710
	return ($level, @res);
711
712
713
714
}
sub ctx_block_outer {
	my ($linenr, $remain) = @_;

715
716
	my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0);
	return @r;
717
718
719
720
}
sub ctx_block {
	my ($linenr, $remain) = @_;

721
722
	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0);
	return @r;
723
724
}
sub ctx_statement {
725
726
727
728
729
730
	my ($linenr, $remain, $off) = @_;

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

733
	return ctx_block_get($linenr, $remain, 0, '{', '}', 0);
734
}
735
736
737
738
739
sub ctx_statement_level {
	my ($linenr, $remain, $off) = @_;

	return ctx_block_get($linenr, $remain, 0, '(', ')', $off);
}
740
741
742
743
744

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

	# Catch a comment on the end of the line itself.
745
	my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@);
746
747
748
749
750
751
752
	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++) {
753
754
		my $line = $rawlines[$linenr - 1];
		#warn "           $line\n";
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
		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);

777
	##print "LINE: $rawlines[$end_line - 1 ]\n";
778
779
780
781
782
	##print "CMMT: $cmt\n";

	return ($cmt ne '');
}

783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
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;
}

799
800
801
sub cat_vet {
	my ($vet) = @_;
	my ($res, $coded);
802

803
804
805
806
807
808
	$res = '';
	while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) {
		$res .= $1;
		if ($2 ne '') {
			$coded = sprintf("^%c", unpack('C', $2) + 64);
			$res .= $coded;
809
810
		}
	}
811
	$res =~ s/$/\$/;
812

813
	return $res;
814
815
}

816
my $av_preprocessor = 0;
817
my $av_pending;
818
my @av_paren_type;
819
my $av_pend_colon;
820
821
822

sub annotate_reset {
	$av_preprocessor = 0;
823
824
	$av_pending = '_';
	@av_paren_type = ('E');
825
	$av_pend_colon = 'O';
826
827
}

828
829
sub annotate_values {
	my ($stream, $type) = @_;
830

831
	my $res;
832
	my $var = '_' x length($stream);
833
834
	my $cur = $stream;

835
	print "$stream\n" if ($dbg_values > 1);
836
837

	while (length($cur)) {
838
		@av_paren_type = ('E') if ($#av_paren_type < 0);
839
		print " <" . join('', @av_paren_type) .
840
				"> <$type> <$av_pending>" if ($dbg_values > 1);
841
		if ($cur =~ /^(\s+)/o) {
842
843
			print "WS($1)\n" if ($dbg_values > 1);
			if ($1 =~ /\n/ && $av_preprocessor) {
844
				$type = pop(@av_paren_type);
845
				$av_preprocessor = 0;
846
847
			}

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

852
853
854
855
		} elsif ($cur =~ /^($Modifier)\s*/) {
			print "MODIFIER($1)\n" if ($dbg_values > 1);
			$type = 'T';

856
		} elsif ($cur =~ /^(\#\s*define\s*$Ident)(\(?)/o) {
857
			print "DEFINE($1,$2)\n" if ($dbg_values > 1);
858
			$av_preprocessor = 1;
859
860
861
862
863
864
			push(@av_paren_type, $type);
			if ($2 ne '') {
				$av_pending = 'N';
			}
			$type = 'E';

865
		} elsif ($cur =~ /^(\#\s*(?:undef\s*$Ident|include\b))/o) {
866
867
868
			print "UNDEF($1)\n" if ($dbg_values > 1);
			$av_preprocessor = 1;
			push(@av_paren_type, $type);
869

870
		} elsif ($cur =~ /^(\#\s*(?:ifdef|ifndef|if))/o) {
871
			print "PRE_START($1)\n" if ($dbg_values > 1);
872
			$av_preprocessor = 1;
873
874
875

			push(@av_paren_type, $type);
			push(@av_paren_type, $type);
876
			$type = 'E';
877

878
		} elsif ($cur =~ /^(\#\s*(?:else|elif))/o) {
879
880
881
882
883
			print "PRE_RESTART($1)\n" if ($dbg_values > 1);
			$av_preprocessor = 1;

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

884
			$type = 'E';
885

886
		} elsif ($cur =~ /^(\#\s*(?:endif))/o) {
887
888
889
890
891
892
893
894
			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);
895
			$type = 'E';
896
897

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

900
901
902
903
904
		} elsif ($cur =~ /^(__attribute__)\s*\(?/o) {
			print "ATTR($1)\n" if ($dbg_values > 1);
			$av_pending = $type;
			$type = 'N';

905
		} elsif ($cur =~ /^(sizeof)\s*(\()?/o) {
906
			print "SIZEOF($1)\n" if ($dbg_values > 1);
907
			if (defined $2) {
908
				$av_pending = 'V';
909
910
911
			}
			$type = 'N';

912
		} elsif ($cur =~ /^(if|while|for)\b/o) {
913
			print "COND($1)\n" if ($dbg_values > 1);
914
			$av_pending = 'E';
915
916
			$type = 'N';

917
918
919
920
921
		} elsif ($cur =~/^(case)/o) {
			print "CASE($1)\n" if ($dbg_values > 1);
			$av_pend_colon = 'C';
			$type = 'N';

922
		} elsif ($cur =~/^(return|else|goto|typeof|__typeof__)\b/o) {
923
			print "KEYWORD($1)\n" if ($dbg_values > 1);
924
925
926
			$type = 'N';

		} elsif ($cur =~ /^(\()/o) {
927
			print "PAREN('$1')\n" if ($dbg_values > 1);
928
929
			push(@av_paren_type, $av_pending);
			$av_pending = '_';
930
931
932
			$type = 'N';

		} elsif ($cur =~ /^(\))/o) {
933
934
935
			my $new_type = pop(@av_paren_type);
			if ($new_type ne '_') {
				$type = $new_type;
936
937
				print "PAREN('$1') -> $type\n"
							if ($dbg_values > 1);
938
			} else {
939
				print "PAREN('$1')\n" if ($dbg_values > 1);
940
941
			}

942
		} elsif ($cur =~ /^($Ident)\s*\(/o) {
943
			print "FUNC($1)\n" if ($dbg_values > 1);
944
			$type = 'V';
945
			$av_pending = 'V';
946

947
948
		} elsif ($cur =~ /^($Ident\s*):(?:\s*\d+\s*(,|=|;))?/) {
			if (defined $2 && $type eq 'C' || $type eq 'T') {
949
				$av_pend_colon = 'B';
950
951
			} elsif ($type eq 'E') {
				$av_pend_colon = 'L';
952
953
954
955
			}
			print "IDENT_COLON($1,$type>$av_pend_colon)\n" if ($dbg_values > 1);
			$type = 'V';

956
		} elsif ($cur =~ /^($Ident|$Constant)/o) {
957
			print "IDENT($1)\n" if ($dbg_values > 1);
958
959
960
			$type = 'V';

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

964
		} elsif ($cur =~/^(;|{|})/) {
965
			print "END($1)\n" if ($dbg_values > 1);
966
			$type = 'E';
967
968
			$av_pend_colon = 'O';

969
970
971
972
		} elsif ($cur =~/^(,)/) {
			print "COMMA($1)\n" if ($dbg_values > 1);
			$type = 'C';

973
974
975
976
977
978
979
980
981
982
983
984
985
986
		} 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';
987

988
		} elsif ($cur =~ /^(\[)/o) {
989
			print "CLOSE($1)\n" if ($dbg_values > 1);
990
991
			$type = 'N';

992
		} elsif ($cur =~ /^(-(?![->])|\+(?!\+)|\*|\&\&|\&)/o) {
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
			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';

1005
		} elsif ($cur =~ /^($Operators)/o) {
1006
			print "OP($1)\n" if ($dbg_values > 1);
1007
1008
1009
1010
1011
			if ($1 ne '++' && $1 ne '--') {
				$type = 'N';
			}

		} elsif ($cur =~ /(^.)/o) {
1012
			print "C($1)\n" if ($dbg_values > 1);
1013
1014
1015
1016
1017
		}
		if (defined $1) {
			$cur = substr($cur, length($1));
			$res .= $type x length($1);
		}
1018
	}
1019

1020
	return ($res, $var);
1021
1022
}

1023
sub possible {
1024
	my ($possible, $line) = @_;
1025
	my $notPermitted = qr{(?:
1026
1027
1028
1029
		^(?:
			$Modifier|
			$Storage|
			$Type|
1030
1031
1032
			DEFINE_\S+
		)$|
		^(?:
1033
1034
1035
1036
1037
1038
			goto|
			return|
			case|
			else|
			asm|__asm__|
			do
1039
		)(?:\s|$)|
1040
		^(?:typedef|struct|enum)\b
1041
1042
1043
	    )}x;
	warn "CHECK<$possible> ($line)\n" if ($dbg_possible > 2);
	if ($possible !~ $notPermitted) {
1044
1045
1046
1047
1048
1049
1050
		# 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;
1051
			for my $modifier (split(' ', $possible)) {
1052
1053
1054
1055
				if ($modifier !~ $notPermitted) {
					warn "MODIFIER: $modifier ($possible) ($line)\n" if ($dbg_possible);
					push(@modifierList, $modifier);
				}
1056
			}
1057
1058
1059
1060
1061

		} else {
			warn "POSSIBLE: $possible ($line)\n" if ($dbg_possible);
			push(@typeList, $possible);
		}
1062
		build_types();
1063
1064
	} else {
		warn "NOTPOSS: $possible ($line)\n" if ($dbg_possible > 1);
1065
1066
1067
	}
}

1068
1069
my $prefix = '';

1070
sub report {
1071
1072
1073
	if (defined $tst_only && $_[0] !~ /\Q$tst_only\E/) {
		return 0;
	}
1074
1075
1076
1077
	my $line = $prefix . $_[0];

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

1078
	push(our @report, $line);
1079
1080

	return 1;
1081
1082
}
sub report_dump {
1083
	our @report;
1084
}
1085
sub ERROR {
1086
1087
1088
1089
	if (report("ERROR: $_[0]\n")) {
		our $clean = 0;
		our $cnt_error++;
	}
1090
1091
}
sub WARN {
1092
1093
1094
1095
	if (report("WARNING: $_[0]\n")) {
		our $clean = 0;
		our $cnt_warn++;
	}
1096
1097
}
sub CHK {
1098
	if ($check && report("CHECK: $_[0]\n")) {
1099
1100
1101
		our $clean = 0;
		our $cnt_chk++;
	}
1102
1103
}

1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
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);
	}
}

1131
1132
1133
1134
1135
sub process {
	my $filename = shift;

	my $linenr=0;
	my $prevline="";
1136
	my $prevrawline="";
1137
	my $stashline="";
1138
	my $stashrawline="";
1139

1140
	my $length;
1141
1142
1143
1144
	my $indent;
	my $previndent=0;
	my $stashindent=0;

1145
	our $clean = 1;
1146
1147
1148
	my $signoff = 0;
	my $is_patch = 0;

1149
	our @report = ();
1150
1151
1152
1153
1154
	our $cnt_lines = 0;
	our $cnt_error = 0;
	our $cnt_warn = 0;
	our $cnt_chk = 0;

1155
1156
1157
1158
1159
1160
	# Trace the real file/line as we go.
	my $realfile = '';
	my $realline = 0;
	my $realcnt = 0;
	my $here = '';
	my $in_comment = 0;
1161
	my $comment_edge = 0;
1162
	my $first_line = 0;
1163
	my $p1_prefix = '';