1419 lines · 37.7 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.11'; 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 $emacs = 0;my $file = 0;my $check = 0;my $root;GetOptions(	'q|quiet+'	=> \$quiet,	'tree!'		=> \$tree,	'signoff!'	=> \$chk_signoff,	'patch!'	=> \$chk_patch,	'test-type!'	=> \$tst_type,	'emacs!'	=> \$emacs,	'file!'		=> \$file,	'subjective!'	=> \$check,	'strict!'	=> \$check,	'root=s'	=> \$root,) 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 "         --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";	exit(1);} 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|			fastcall		}x;our $Attribute	= qr{			const|			__read_mostly|			__kprobes|			__(?:mem|cpu|dev|)(?:initdata|init)		  }x;our $Inline	= qr{inline|__always_inline|noinline};our $NonptrType	= qr{			\b			(?:const\s+)?			(?:unsigned\s+)?			(?:				void|				char|				short|				int|				long|				unsigned|				float|				double|				bool|				long\s+int|				long\s+long|				long\s+long\s+int|				(?:__)?(?:u|s|be|le)(?:8|16|32|64)|				struct\s+$Ident|				union\s+$Ident|				enum\s+$Ident|				${Ident}_t|				${Ident}_handler|				${Ident}_handler_fn			)			(?:\s+$Sparse)*			\b		  }x; our $Type	= qr{			\b$NonptrType\b			(?:\s*\*+\s*const|\s*\*+|(?:\s*\[\s*\])+)?			(?:\s+$Sparse|\s+$Attribute)*		  }x;our $Declare	= qr{(?:$Storage\s+)?$Type};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 $Bare = ''; $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 = ();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";	}	while (<FILE>) {		chomp;		push(@rawlines, $_);	}	close(FILE);	if (!process($filename, @rawlines)) {		$exit = 1;	}	@rawlines = ();} 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 ($str) = @_; 	my $res = '';	for my $c (split(//, $str)) {		if ($c eq "\t") {			$res .= $c;		} else {			$res .= ' ';		}	} 	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));} sub sanitise_line {	my ($line) = @_; 	my $res = '';	my $l = ''; 	my $quote = ''; 	foreach my $c (split(//, $line)) {		if ($l ne "\\" && ($c eq "'" || $c eq '"')) {			if ($quote eq '') {				$quote = $c;				$res .= $c;				$l = $c;				next;			} elsif ($quote eq $c) {				$quote = '';			}		}		if ($quote && $c ne "\t") {			$res .= "X";		} else {			$res .= $c;		} 		$l = $c;	} 	return $res;} sub ctx_block_get {	my ($linenr, $remain, $outer, $open, $close, $off) = @_;	my $line;	my $start = $linenr - 1;	my $blk = '';	my @o;	my @c;	my @res = (); 	my $level = 0;	for ($line = $start; $remain > 0; $line++) {		next if ($rawlines[$line] =~ /^-/);		$remain--; 		$blk .= $rawlines[$line];		foreach my $c (split(//, $rawlines[$line])) {			##print "C<$c>L<$level><$open$close>O<$off>\n";			if ($off > 0) {				$off--;				next;			} 			if ($c eq $close && $level > 0) {				$level--;				last if ($level == 0);			} elsif ($c eq $open) {				$level++;			}		} 		if (!$outer || $level <= 1) {			push(@res, $rawlines[$line]);		} 		last if ($level == 0);	} 	return ($level, @res);}sub ctx_block_outer {	my ($linenr, $remain) = @_; 	my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0);	return @r;}sub ctx_block {	my ($linenr, $remain) = @_; 	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0);	return @r;}sub ctx_statement {	my ($linenr, $remain, $off) = @_; 	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '(', ')', $off);	return @r;}sub ctx_block_level {	my ($linenr, $remain) = @_; 	return ctx_block_get($linenr, $remain, 0, '{', '}', 0);}sub ctx_statement_level {	my ($linenr, $remain, $off) = @_; 	return ctx_block_get($linenr, $remain, 0, '(', ')', $off);} sub ctx_locate_comment {	my ($first_line, $end_line) = @_; 	# Catch a comment on the end of the line itself.	my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*$@);	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++) {		my $line = $rawlines[$linenr - 1];		#warn "           $line\n";		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); 	##print "LINE: $rawlines[$end_line - 1 ]\n";	##print "CMMT: $cmt\n"; 	return ($cmt ne '');} sub cat_vet {	my ($vet) = @_;	my ($res, $coded); 	$res = '';	while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) {		$res .= $1;		if ($2 ne '') {			$coded = sprintf("^%c", unpack('C', $2) + 64);			$res .= $coded;		}	}	$res =~ s/$/\$/; 	return $res;} sub annotate_values {	my ($stream, $type) = @_; 	my $res;	my $cur = $stream; 	my $debug = 0; 	print "$stream\n" if ($debug); 	##my $type = 'N';	my $pos = 0;	my $preprocessor = 0;	my $paren = 0;	my @paren_type; 	# Include any user defined types we may have found as we went.	my $type_match = "(?:$Type$Bare)"; 	while (length($cur)) {		print " <$type> " if ($debug);		if ($cur =~ /^(\s+)/o) {			print "WS($1)\n" if ($debug);			if ($1 =~ /\n/ && $preprocessor) {				$preprocessor = 0;				$type = 'N';			} 		} elsif ($cur =~ /^($type_match)/) {			print "DECLARE($1)\n" if ($debug);			$type = 'T'; 		} elsif ($cur =~ /^(#\s*define\s*$Ident)(\(?)/o) {			print "DEFINE($1)\n" if ($debug);			$preprocessor = 1;			$paren_type[$paren] = 'N'; 		} elsif ($cur =~ /^(#\s*(?:ifdef|ifndef|if|else|endif))/o) {			print "PRE($1)\n" if ($debug);			$preprocessor = 1;			$type = 'N'; 		} elsif ($cur =~ /^(\\\n)/o) {			print "PRECONT($1)\n" if ($debug); 		} elsif ($cur =~ /^(sizeof)\s*(\()?/o) {			print "SIZEOF($1)\n" if ($debug);			if (defined $2) {				$paren_type[$paren] = 'V';			}			$type = 'N'; 		} elsif ($cur =~ /^(if|while|typeof)\b/o) {			print "COND($1)\n" if ($debug);			$paren_type[$paren] = 'N';			$type = 'N'; 		} elsif ($cur =~/^(return|case|else)/o) {			print "KEYWORD($1)\n" if ($debug);			$type = 'N'; 		} elsif ($cur =~ /^(\()/o) {			print "PAREN('$1')\n" if ($debug);			$paren++;			$type = 'N'; 		} elsif ($cur =~ /^(\))/o) {			$paren-- if ($paren > 0);			if (defined $paren_type[$paren]) {				$type = $paren_type[$paren];				undef $paren_type[$paren];				print "PAREN('$1') -> $type\n" if ($debug);			} else {				print "PAREN('$1')\n" if ($debug);			} 		} elsif ($cur =~ /^($Ident)\(/o) {			print "FUNC($1)\n" if ($debug);			$paren_type[$paren] = 'V'; 		} elsif ($cur =~ /^($Ident|$Constant)/o) {			print "IDENT($1)\n" if ($debug);			$type = 'V'; 		} elsif ($cur =~ /^($Assignment)/o) {			print "ASSIGN($1)\n" if ($debug);			$type = 'N'; 		} elsif ($cur =~ /^(;|{|}|\?|:|\[)/o) {			print "END($1)\n" if ($debug);			$type = 'N'; 		} elsif ($cur =~ /^($Operators)/o) {

Lines 1–500 of 1419.