checkpatch.pl 77.9 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.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
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
213
our $logFunctions = qr{(?x:
	printk|
	pr_(debug|dbg|vdbg|devel|info|warning|err|notice|alert|crit|emerg|cont)|
214
	(dev|netdev|netif)_(printk|dbg|vdbg|info|warn|err|notice|alert|crit|emerg|WARN)|
215
216
217
218
	WARN|
	panic
)};

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

$chk_signoff = 0 if ($file);

273
274
my @dep_includes = ();
my @dep_functions = ();
275
276
my $removal = "Documentation/feature-removal-schedule.txt";
if ($tree && -f "$root/$removal") {
277
	open(my $REMOVE, '<', "$root/$removal") ||
278
				die "$P: $removal: open failed - $!\n";
279
	while (<$REMOVE>) {
280
281
282
		if (/^Check:\s+(.*\S)/) {
			for my $entry (split(/[, ]+/, $1)) {
				if ($entry =~ m@include/(.*)@) {
283
284
					push(@dep_includes, $1);

285
286
287
				} elsif ($entry !~ m@/@) {
					push(@dep_functions, $entry);
				}
288
			}
289
290
		}
	}
291
	close($REMOVE);
292
293
}

294
my @rawlines = ();
295
296
my @lines = ();
my $vname;
297
for my $filename (@ARGV) {
298
	my $FILE;
299
	if ($file) {
300
		open($FILE, '-|', "diff -u /dev/null $filename") ||
301
			die "$P: $filename: diff failed - $!\n";
302
303
	} elsif ($filename eq '-') {
		open($FILE, '<&STDIN');
304
	} else {
305
		open($FILE, '<', "$filename") ||
306
			die "$P: $filename: open failed - $!\n";
307
	}
308
309
310
311
312
	if ($filename eq '-') {
		$vname = 'Your patch';
	} else {
		$vname = $filename;
	}
313
	while (<$FILE>) {
314
315
316
		chomp;
		push(@rawlines, $_);
	}
317
	close($FILE);
318
	if (!process($filename)) {
319
320
321
		$exit = 1;
	}
	@rawlines = ();
322
	@lines = ();
323
324
325
326
327
}

exit($exit);

sub top_of_kernel_tree {
328
329
330
331
332
333
334
335
336
337
338
339
	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;
		}
340
	}
341
	return 1;
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
}

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;
}
364
sub copy_spacing {
365
	(my $res = shift) =~ tr/\t/ /c;
366
367
	return $res;
}
368

369
370
371
372
373
374
375
376
377
378
379
380
381
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));
}

382
383
384
385
386
387
388
389
390
391
392
my $sanitise_quote = '';

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

	if ($in_comment) {
		$sanitise_quote = '*/';
	} else {
		$sanitise_quote = '';
	}
}
393
394
395
396
397
398
sub sanitise_line {
	my ($line) = @_;

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

399
	my $qlen = 0;
400
401
	my $off = 0;
	my $c;
402

403
404
405
406
407
408
409
410
411
412
413
414
415
416
	# 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;
417
		}
418
		if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') {
419
420
421
422
			$sanitise_quote = '';
			substr($res, $off, 2, "$;$;");
			$off++;
			next;
423
		}
424
425
426
427
428
429
430
		if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') {
			$sanitise_quote = '//';

			substr($res, $off, 2, $sanitise_quote);
			$off++;
			next;
		}
431
432
433
434
435
436
437

		# 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;
438
		}
439
440
441
442
		# Regular quotes.
		if ($c eq "'" || $c eq '"') {
			if ($sanitise_quote eq '') {
				$sanitise_quote = $c;
443

444
445
446
447
448
449
				substr($res, $off, 1, $c);
				next;
			} elsif ($sanitise_quote eq $c) {
				$sanitise_quote = '';
			}
		}
450

451
		#print "c<$c> SQ<$sanitise_quote>\n";
452
453
		if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") {
			substr($res, $off, 1, $;);
454
455
		} elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") {
			substr($res, $off, 1, $;);
456
457
458
459
460
		} elsif ($off != 0 && $sanitise_quote && $c ne "\t") {
			substr($res, $off, 1, 'X');
		} else {
			substr($res, $off, 1, $c);
		}
461
462
	}

463
464
465
466
	if ($sanitise_quote eq '//') {
		$sanitise_quote = '';
	}

467
	# The pathname on a #include may be surrounded by '<' and '>'.
468
	if ($res =~ /^.\s*\#\s*include\s+\<(.*)\>/) {
469
470
471
472
		my $clean = 'X' x length($1);
		$res =~ s@\<.*\>@<$clean>@;

	# The whole of a #error is a string.
473
	} elsif ($res =~ /^.\s*\#\s*(?:error|warning)\s+(.*)\b/) {
474
		my $clean = 'X' x length($1);
475
		$res =~ s@(\#\s*(?:error|warning)\s+).*@$1$clean@;
476
477
	}

478
479
480
	return $res;
}

481
482
483
484
485
486
sub ctx_statement_block {
	my ($linenr, $remain, $off) = @_;
	my $line = $linenr - 1;
	my $blk = '';
	my $soff = $off;
	my $coff = $off - 1;
487
	my $coff_set = 0;
488

489
490
	my $loff = 0;

491
492
	my $type = '';
	my $level = 0;
493
	my @stack = ();
494
	my $p;
495
496
	my $c;
	my $len = 0;
497
498

	my $remainder;
499
	while (1) {
500
501
		@stack = (['', 0]) if ($#stack == -1);

502
		#warn "CSB: blk<$blk> remain<$remain>\n";
503
504
505
506
		# If we are about to drop off the end, pull in more
		# context.
		if ($off >= $len) {
			for (; $remain > 0; $line++) {
507
				last if (!defined $lines[$line]);
508
				next if ($lines[$line] =~ /^-/);
509
				$remain--;
510
				$loff = $len;
511
				$blk .= $lines[$line] . "\n";
512
513
514
515
516
517
				$len = length($blk);
				$line++;
				last;
			}
			# Bail if there is no further context.
			#warn "CSB: blk<$blk> off<$off> len<$len>\n";
518
			if ($off >= $len) {
519
520
521
				last;
			}
		}
522
		$p = $c;
523
		$c = substr($blk, $off, 1);
524
		$remainder = substr($blk, $off);
525

526
		#warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>\n";
527
528
529
530
531
532
533
534
535
536

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

537
538
539
540
541
542
		# Statement ends at the ';' or a close '}' at the
		# outermost level.
		if ($level == 0 && $c eq ';') {
			last;
		}

543
		# An else is really a conditional as long as its not else if
544
545
546
547
548
549
550
551
		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";
552
553
		}

554
555
556
557
558
559
560
561
562
563
		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;
564
565
				$coff_set = 1;
				#warn "CSB: mark coff<$coff>\n";
566
567
568
569
570
571
572
573
574
575
576
			}
		}
		if (($type eq '' || $type eq '{') && $c eq '{') {
			$level++;
			$type = '{';
		}
		if ($type eq '{' && $c eq '}') {
			$level--;
			$type = ($level != 0)? '{' : '';

			if ($level == 0) {
577
578
579
				if (substr($blk, $off + 1, 1) eq ';') {
					$off++;
				}
580
581
582
583
584
				last;
			}
		}
		$off++;
	}
585
	# We are truly at the end, so shuffle to the next line.
586
	if ($off == $len) {
587
		$loff = $len + 1;
588
589
590
		$line++;
		$remain--;
	}
591
592
593
594
595
596
597

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

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

598
	#print "coff<$coff> soff<$off> loff<$loff>\n";
599
600
601
602
603

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

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
633
634
635
636
637
638
639
640
641
642
643
644
645
646
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;
	}
}

647
648
649
650
651
652
sub ctx_statement_full {
	my ($linenr, $remain, $off) = @_;
	my ($statement, $condition, $level);

	my (@chunks);

653
	# Grab the first conditional/block pair.
654
655
	($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
656
	#print "F: c<$condition> s<$statement> remain<$remain>\n";
657
658
659
660
661
662
663
	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.
664
665
666
	for (;;) {
		($statement, $condition, $linenr, $remain, $off, $level) =
				ctx_statement_block($linenr, $remain, $off);
667
		#print "C: c<$condition> s<$statement> remain<$remain>\n";
668
		last if (!($remain > 0 && $condition =~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s));
669
670
		#print "C: push\n";
		push(@chunks, [ $condition, $statement ]);
671
672
673
	}

	return ($level, $linenr, @chunks);
674
675
}

676
sub ctx_block_get {
677
	my ($linenr, $remain, $outer, $open, $close, $off) = @_;
678
679
680
681
682
683
684
	my $line;
	my $start = $linenr - 1;
	my $blk = '';
	my @o;
	my @c;
	my @res = ();

685
	my $level = 0;
686
	my @stack = ($level);
687
688
689
690
691
	for ($line = $start; $remain > 0; $line++) {
		next if ($rawlines[$line] =~ /^-/);
		$remain--;

		$blk .= $rawlines[$line];
692
693
694
695
696
697
698
699
700
701

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

702
703
704
705
706
707
		foreach my $c (split(//, $rawlines[$line])) {
			##print "C<$c>L<$level><$open$close>O<$off>\n";
			if ($off > 0) {
				$off--;
				next;
			}
708

709
710
711
712
713
714
715
			if ($c eq $close && $level > 0) {
				$level--;
				last if ($level == 0);
			} elsif ($c eq $open) {
				$level++;
			}
		}
716

717
		if (!$outer || $level <= 1) {
718
			push(@res, $rawlines[$line]);
719
720
		}

721
		last if ($level == 0);
722
723
	}

724
	return ($level, @res);
725
726
727
728
}
sub ctx_block_outer {
	my ($linenr, $remain) = @_;

729
730
	my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0);
	return @r;
731
732
733
734
}
sub ctx_block {
	my ($linenr, $remain) = @_;

735
736
	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0);
	return @r;
737
738
}
sub ctx_statement {
739
740
741
742
743
744
	my ($linenr, $remain, $off) = @_;

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

747
	return ctx_block_get($linenr, $remain, 0, '{', '}', 0);
748
}
749
750
751
752
753
sub ctx_statement_level {
	my ($linenr, $remain, $off) = @_;

	return ctx_block_get($linenr, $remain, 0, '(', ')', $off);
}
754
755
756
757
758

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

	# Catch a comment on the end of the line itself.
759
	my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@);
760
761
762
763
764
765
766
	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++) {
767
768
		my $line = $rawlines[$linenr - 1];
		#warn "           $line\n";
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
		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);

791
	##print "LINE: $rawlines[$end_line - 1 ]\n";
792
793
794
795
796
	##print "CMMT: $cmt\n";

	return ($cmt ne '');
}

797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
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;
}

813
814
815
sub cat_vet {
	my ($vet) = @_;
	my ($res, $coded);
816

817
818
819
820
821
822
	$res = '';
	while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) {
		$res .= $1;
		if ($2 ne '') {
			$coded = sprintf("^%c", unpack('C', $2) + 64);
			$res .= $coded;
823
824
		}
	}
825
	$res =~ s/$/\$/;
826

827
	return $res;
828
829
}

830
my $av_preprocessor = 0;
831
my $av_pending;
832
my @av_paren_type;
833
my $av_pend_colon;
834
835
836

sub annotate_reset {
	$av_preprocessor = 0;
837
838
	$av_pending = '_';
	@av_paren_type = ('E');
839
	$av_pend_colon = 'O';
840
841
}

842
843
sub annotate_values {
	my ($stream, $type) = @_;
844

845
	my $res;
846
	my $var = '_' x length($stream);
847
848
	my $cur = $stream;

849
	print "$stream\n" if ($dbg_values > 1);
850
851

	while (length($cur)) {
852
		@av_paren_type = ('E') if ($#av_paren_type < 0);
853
		print " <" . join('', @av_paren_type) .
854
				"> <$type> <$av_pending>" if ($dbg_values > 1);
855
		if ($cur =~ /^(\s+)/o) {
856
857
			print "WS($1)\n" if ($dbg_values > 1);
			if ($1 =~ /\n/ && $av_preprocessor) {
858
				$type = pop(@av_paren_type);
859
				$av_preprocessor = 0;
860
861
			}

862
863
864
865
866
		} elsif ($cur =~ /^(\(\s*$Type\s*)\)/) {
			print "CAST($1)\n" if ($dbg_values > 1);
			push(@av_paren_type, $type);
			$type = 'C';

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

871
872
873
874
		} elsif ($cur =~ /^($Modifier)\s*/) {
			print "MODIFIER($1)\n" if ($dbg_values > 1);
			$type = 'T';

875
		} elsif ($cur =~ /^(\#\s*define\s*$Ident)(\(?)/o) {
876
			print "DEFINE($1,$2)\n" if ($dbg_values > 1);
877
			$av_preprocessor = 1;
878
879
880
881
882
883
			push(@av_paren_type, $type);
			if ($2 ne '') {
				$av_pending = 'N';
			}
			$type = 'E';

884
		} elsif ($cur =~ /^(\#\s*(?:undef\s*$Ident|include\b))/o) {
885
886
887
			print "UNDEF($1)\n" if ($dbg_values > 1);
			$av_preprocessor = 1;
			push(@av_paren_type, $type);
888

889
		} elsif ($cur =~ /^(\#\s*(?:ifdef|ifndef|if))/o) {
890
			print "PRE_START($1)\n" if ($dbg_values > 1);
891
			$av_preprocessor = 1;
892
893
894

			push(@av_paren_type, $type);
			push(@av_paren_type, $type);
895
			$type = 'E';
896

897
		} elsif ($cur =~ /^(\#\s*(?:else|elif))/o) {
898
899
900
901
902
			print "PRE_RESTART($1)\n" if ($dbg_values > 1);
			$av_preprocessor = 1;

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

903
			$type = 'E';
904

905
		} elsif ($cur =~ /^(\#\s*(?:endif))/o) {
906
907
908
909
910
911
912
913
			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);
914
			$type = 'E';
915
916

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

919
920
921
922
923
		} elsif ($cur =~ /^(__attribute__)\s*\(?/o) {
			print "ATTR($1)\n" if ($dbg_values > 1);
			$av_pending = $type;
			$type = 'N';

924
		} elsif ($cur =~ /^(sizeof)\s*(\()?/o) {
925
			print "SIZEOF($1)\n" if ($dbg_values > 1);
926
			if (defined $2) {
927
				$av_pending = 'V';
928
929
930
			}
			$type = 'N';

931
		} elsif ($cur =~ /^(if|while|for)\b/o) {
932
			print "COND($1)\n" if ($dbg_values > 1);
933
			$av_pending = 'E';
934
935
			$type = 'N';

936
937
938
939
940
		} elsif ($cur =~/^(case)/o) {
			print "CASE($1)\n" if ($dbg_values > 1);
			$av_pend_colon = 'C';
			$type = 'N';

941
		} elsif ($cur =~/^(return|else|goto|typeof|__typeof__)\b/o) {
942
			print "KEYWORD($1)\n" if ($dbg_values > 1);
943
944
945
			$type = 'N';

		} elsif ($cur =~ /^(\()/o) {
946
			print "PAREN('$1')\n" if ($dbg_values > 1);
947
948
			push(@av_paren_type, $av_pending);
			$av_pending = '_';
949
950
951
			$type = 'N';

		} elsif ($cur =~ /^(\))/o) {
952
953
954
			my $new_type = pop(@av_paren_type);
			if ($new_type ne '_') {
				$type = $new_type;
955
956
				print "PAREN('$1') -> $type\n"
							if ($dbg_values > 1);
957
			} else {
958
				print "PAREN('$1')\n" if ($dbg_values > 1);
959
960
			}

961
		} elsif ($cur =~ /^($Ident)\s*\(/o) {
962
			print "FUNC($1)\n" if ($dbg_values > 1);
963
			$type = 'V';
964
			$av_pending = 'V';
965

966
967
		} elsif ($cur =~ /^($Ident\s*):(?:\s*\d+\s*(,|=|;))?/) {
			if (defined $2 && $type eq 'C' || $type eq 'T') {
968
				$av_pend_colon = 'B';
969
970
			} elsif ($type eq 'E') {
				$av_pend_colon = 'L';
971
972
973
974
			}
			print "IDENT_COLON($1,$type>$av_pend_colon)\n" if ($dbg_values > 1);
			$type = 'V';

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

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

983
		} elsif ($cur =~/^(;|{|})/) {
984
			print "END($1)\n" if ($dbg_values > 1);
985
			$type = 'E';
986
987
			$av_pend_colon = 'O';

988
989
990
991
		} elsif ($cur =~/^(,)/) {
			print "COMMA($1)\n" if ($dbg_values > 1);
			$type = 'C';

992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
		} 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';
1006

1007
		} elsif ($cur =~ /^(\[)/o) {
1008
			print "CLOSE($1)\n" if ($dbg_values > 1);
1009
1010
			$type = 'N';

1011
		} elsif ($cur =~ /^(-(?![->])|\+(?!\+)|\*|\&\&|\&)/o) {
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
			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';

1024
		} elsif ($cur =~ /^($Operators)/o) {
1025
			print "OP($1)\n" if ($dbg_values > 1);
1026
1027
1028
1029
1030
			if ($1 ne '++' && $1 ne '--') {
				$type = 'N';
			}

		} elsif ($cur =~ /(^.)/o) {
1031
			print "C($1)\n" if ($dbg_values > 1);
1032
1033
1034
1035
1036
		}
		if (defined $1) {
			$cur = substr($cur, length($1));
			$res .= $type x length($1);
		}
1037
	}
1038

1039
	return ($res, $var);
1040
1041
}

1042
sub possible {
1043
	my ($possible, $line) = @_;
1044
	my $notPermitted = qr{(?:
1045
1046
1047
1048
		^(?:
			$Modifier|
			$Storage|
			$Type|
1049
1050
1051
			DEFINE_\S+
		)$|
		^(?:
1052
1053
1054
1055
1056
1057
			goto|
			return|
			case|
			else|
			asm|__asm__|
			do
1058
		)(?:\s|$)|
1059
		^(?:typedef|struct|enum)\b
1060
1061
1062
	    )}x;
	warn "CHECK<$possible> ($line)\n" if ($dbg_possible > 2);
	if ($possible !~ $notPermitted) {
1063
1064
1065
1066
1067
1068
1069
		# 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;
1070
			for my $modifier (split(' ', $possible)) {
1071
1072
1073
1074
				if ($modifier !~ $notPermitted) {
					warn "MODIFIER: $modifier ($possible) ($line)\n" if ($dbg_possible);
					push(@modifierList, $modifier);
				}
1075
			}
1076
1077
1078
1079
1080

		} else {
			warn "POSSIBLE: $possible ($line)\n" if ($dbg_possible);
			push(@typeList, $possible);
		}
1081
		build_types();
1082
1083
	} else {
		warn "NOTPOSS: $possible ($line)\n" if ($dbg_possible > 1);
1084
1085
1086
	}
}

1087
1088
my $prefix = '';

1089
sub report {
1090
1091
1092
	if (defined $tst_only && $_[0] !~ /\Q$tst_only\E/) {
		return 0;
	}
1093
1094
1095
1096
	my $line = $prefix . $_[0];

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

1097
	push(our @report, $line);
1098
1099

	return 1;
1100
1101
}
sub report_dump {
1102
	our @report;
1103
}
1104
sub ERROR {
1105
1106
1107
1108
	if (report("ERROR: $_[0]\n")) {
		our $clean = 0;
		our $cnt_error++;
	}
1109
1110
}
sub WARN {
1111
1112
1113
1114
	if (report("WARNING: $_[0]\n")) {
		our $clean = 0;
		our $cnt_warn++;
	}
1115
1116
}
sub CHK {
1117
	if ($check && report("CHECK: $_[0]\n")) {
1118
1119
1120
		our $clean = 0;
		our $cnt_chk++;
	}
1121
1122
}

1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
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);
	}
}

1150
1151
1152
1153
1154
sub process {
	my $filename = shift;

	my $linenr=0;
	my $prevline="";
1155
	my $prevrawline="";
1156
	my $stashline="";
1157
	my $stashrawline="";
1158

1159
	my $length;
1160
1161
1162
1163
	my $indent;
	my $previndent=0;
	my $stashindent=0;

1164
	our $clean = 1;
1165
1166
1167
	my $signoff = 0;
	my $is_patch = 0;

1168
	our @report = ();
1169
1170
1171
1172
1173
	our $cnt_lines = 0;
	our $cnt_error = 0;