#!/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. Load more
#!/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) {