2097 lines · 55.0 KB · Perl
RawDownload
#!/usr/bin/perl -w# (c) 2001, Dave Jones. <davej@codemonkey.org.uk> (the file handling bit)# (c) 2005, Joel Schopp <jschopp@austin.ibm.com> (the ugly bit)# (c) 2007, Andy Whitcroft <apw@uk.ibm.com> (new conditions, test suite, etc)# Licensed under the terms of the GNU GPL License version 2 use strict; my $P = $0;$P =~ s@.*/@@g; my $V = '0.18'; use Getopt::Long qw(:config no_auto_abbrev); my $quiet = 0;my $tree = 1;my $chk_signoff = 1;my $chk_patch = 1;my $tst_type = 0;my $tst_only;my $emacs = 0;my $terse = 0;my $file = 0;my $check = 0;my $summary = 1;my $mailback = 0;my $summary_file = 0;my $root;my %debug;GetOptions(	'q|quiet+'	=> \$quiet,	'tree!'		=> \$tree,	'signoff!'	=> \$chk_signoff,	'patch!'	=> \$chk_patch,	'emacs!'	=> \$emacs,	'terse!'	=> \$terse,	'file!'		=> \$file,	'subjective!'	=> \$check,	'strict!'	=> \$check,	'root=s'	=> \$root,	'summary!'	=> \$summary,	'mailback!'	=> \$mailback,	'summary-file!'	=> \$summary_file, 	'debug=s'	=> \%debug,	'test-type!'	=> \$tst_type,	'test-only=s'	=> \$tst_only,) or exit; my $exit = 0; if ($#ARGV < 0) {	print "usage: $P [options] patchfile\n";	print "version: $V\n";	print "options: -q               => quiet\n";	print "         --no-tree        => run without a kernel tree\n";	print "         --terse          => one line per report\n";	print "         --emacs          => emacs compile window format\n";	print "         --file           => check a source file\n";	print "         --strict         => enable more subjective tests\n";	print "         --root           => path to the kernel tree root\n";	print "         --no-summary     => suppress the per-file summary\n";	print "         --summary-file   => include the filename in summary\n";	exit(1);} my $dbg_values = 0;my $dbg_possible = 0;for my $key (keys %debug) {	eval "\${dbg_$key} = '$debug{$key}';"} if ($terse) {	$emacs = 1;	$quiet++;} 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);	}} my $emitted_corrupt = 0; our $Ident       = qr{[A-Za-z_][A-Za-z\d_]*};our $Storage	= qr{extern|static|asmlinkage};our $Sparse	= qr{			__user|			__kernel|			__force|			__iomem|			__must_check|			__init_refok|			__kprobes		}x;our $Attribute	= qr{			const|			__read_mostly|			__kprobes|			__(?:mem|cpu|dev|)(?:initdata|init)		  }x;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{(?:\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=)};our $Operators	= qr{			<=|>=|==|!=|			=>|->|<<|>>|<|>|!|~|			&&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|%		  }x; our $NonptrType;our $Type;our $Declare; 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; our @typeList = (	qr{void},	qr{char},	qr{short},	qr{int},	qr{long},	qr{unsigned},	qr{float},	qr{double},	qr{bool},	qr{long\s+int},	qr{long\s+long},	qr{long\s+long\s+int},	qr{(?:__)?(?:u|s|be|le)(?:8|16|32|64)},	qr{struct\s+$Ident},	qr{union\s+$Ident},	qr{enum\s+$Ident},	qr{${Ident}_t},	qr{${Ident}_handler},	qr{${Ident}_handler_fn},); sub build_types {	my $all = "(?:  \n" . join("|\n  ", @typeList) . "\n)";	$NonptrType	= qr{			\b			(?:const\s+)?			(?:unsigned\s+)?			(?:				$all|				(?:typeof|__typeof__)\s*\(\s*\**\s*$Ident\s*\)			)			(?:\s+$Sparse|\s+const)*			\b		  }x;	$Type	= qr{			\b$NonptrType\b			(?:\s*\*+\s*const|\s*\*+|(?:\s*\[\s*\])+)?			(?:\s+$Inline|\s+$Sparse|\s+$Attribute)*		  }x;	$Declare	= qr{(?:$Storage\s+)?$Type};}build_types(); $chk_signoff = 0 if ($file); my @dep_includes = ();my @dep_functions = ();my $removal = "Documentation/feature-removal-schedule.txt";if ($tree && -f "$root/$removal") {	open(REMOVE, "<$root/$removal") ||				die "$P: $removal: open failed - $!\n";	while (<REMOVE>) {		if (/^Check:\s+(.*\S)/) {			for my $entry (split(/[, ]+/, $1)) {				if ($entry =~ m@include/(.*)@) {					push(@dep_includes, $1); 				} elsif ($entry !~ m@/@) {					push(@dep_functions, $entry);				}			}		}	}} my @rawlines = ();my @lines = ();my $vname;for my $filename (@ARGV) {	if ($file) {		open(FILE, "diff -u /dev/null $filename|") ||			die "$P: $filename: diff failed - $!\n";	} else {		open(FILE, "<$filename") ||			die "$P: $filename: open failed - $!\n";	}	if ($filename eq '-') {		$vname = 'Your patch';	} else {		$vname = $filename;	}	while (<FILE>) {		chomp;		push(@rawlines, $_);	}	close(FILE);	if (!process($filename)) {		$exit = 1;	}	@rawlines = ();	@lines = ();} exit($exit); sub top_of_kernel_tree {	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;		}	}	return 1;} 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;}sub copy_spacing {	(my $res = shift) =~ tr/\t/ /c;	return $res;} 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));} my $sanitise_quote = ''; sub sanitise_line_reset {	my ($in_comment) = @_; 	if ($in_comment) {		$sanitise_quote = '*/';	} else {		$sanitise_quote = '';	}}sub sanitise_line {	my ($line) = @_; 	my $res = '';	my $l = ''; 	my $qlen = 0;	my $off = 0;	my $c; 	# 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;		}		if (substr($line, $off, 2) eq $sanitise_quote) {			$sanitise_quote = '';			substr($res, $off, 2, "$;$;");			$off++;			next;		} 		# 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;		}		# Regular quotes.		if ($c eq "'" || $c eq '"') {			if ($sanitise_quote eq '') {				$sanitise_quote = $c; 				substr($res, $off, 1, $c);				next;			} elsif ($sanitise_quote eq $c) {				$sanitise_quote = '';			}		} 		#print "SQ:$sanitise_quote\n";		if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") {			substr($res, $off, 1, $;);		} elsif ($off != 0 && $sanitise_quote && $c ne "\t") {			substr($res, $off, 1, 'X');		} else {			substr($res, $off, 1, $c);		}	} 	# The pathname on a #include may be surrounded by '<' and '>'.	if ($res =~ /^.#\s*include\s+\<(.*)\>/) {		my $clean = 'X' x length($1);		$res =~ s@\<.*\>@<$clean>@; 	# The whole of a #error is a string.	} elsif ($res =~ /^.#\s*(?:error|warning)\s+(.*)\b/) {		my $clean = 'X' x length($1);		$res =~ s@(#\s*(?:error|warning)\s+).*@$1$clean@;	} 	return $res;} sub ctx_statement_block {	my ($linenr, $remain, $off) = @_;	my $line = $linenr - 1;	my $blk = '';	my $soff = $off;	my $coff = $off - 1;	my $coff_set = 0; 	my $loff = 0; 	my $type = '';	my $level = 0;	my $p;	my $c;	my $len = 0; 	my $remainder;	while (1) {		#warn "CSB: blk<$blk> remain<$remain>\n";		# If we are about to drop off the end, pull in more		# context.		if ($off >= $len) {			for (; $remain > 0; $line++) {				next if ($lines[$line] =~ /^-/);				$remain--;				$loff = $len;				$blk .= $lines[$line] . "\n";				$len = length($blk);				$line++;				last;			}			# Bail if there is no further context.			#warn "CSB: blk<$blk> off<$off> len<$len>\n";			if ($off >= $len) {				last;			}		}		$p = $c;		$c = substr($blk, $off, 1);		$remainder = substr($blk, $off); 		#warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>\n";		# Statement ends at the ';' or a close '}' at the		# outermost level.		if ($level == 0 && $c eq ';') {			last;		} 		# An else is really a conditional as long as its not else if		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";		} 		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;				$coff_set = 1;				#warn "CSB: mark coff<$coff>\n";			}		}		if (($type eq '' || $type eq '{') && $c eq '{') {			$level++;			$type = '{';		}		if ($type eq '{' && $c eq '}') {			$level--;			$type = ($level != 0)? '{' : ''; 			if ($level == 0) {				last;			}		}		$off++;	}	if ($off == $len) {		$line++;		$remain--;	} 	my $statement = substr($blk, $soff, $off - $soff + 1);	my $condition = substr($blk, $soff, $coff - $soff + 1); 	#warn "STATEMENT<$statement>\n";	#warn "CONDITION<$condition>\n"; 	#print "coff<$coff> soff<$off> loff<$loff>\n"; 	return ($statement, $condition,			$line, $remain + 1, $off - $loff + 1, $level);} 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) = @_;

Lines 1–500 of 2097.