#!/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.15'; 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 $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,) 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 @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 ($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 = ''; my $qlen = 0; foreach my $c (split(//, $line)) { # The second backslash of a pair is not a "quote". if ($l eq "\\" && $c eq "\\") { $c = 'X'; } if ($l ne "\\" && ($c eq "'" || $c eq '"')) { if ($quote eq '') { $quote = $c; $res .= $c; $l = $c; $qlen = 0; next; } elsif ($quote eq $c) { $quote = ''; } } if ($quote eq "'" && $qlen > 1) { $quote = ''; } if ($quote && $c ne "\t") { $res .= "X"; $qlen++; } else { $res .= $c; } $l = $c; } # Clear out the comments. while ($res =~ m@(/\*.*?\*/)@g) { substr($res, $-[1], $+[1] - $-[1]) = $; x ($+[1] - $-[1]); } if ($res =~ m@(/\*.*)@) { substr($res, $-[1], $+[1] - $-[1]) = $; x ($+[1] - $-[1]); } if ($res =~ m@^.(.*\*/)@) { substr($res, $-[1], $+[1] - $-[1]) = $; x ($+[1] - $-[1]); } # 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 $loff = 0; my $type = ''; my $level = 0; my $p; my $c; my $len = 0; my $remainder; while (1) { #warn "CSB: blk<$blk>\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>\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 && (!defined($p) || $p =~ /(?:\s|\})/) && $remainder =~ /(else)(?:\s|{)/ && $remainder !~ /else\s+if\b/) { $coff = $off + length($1); } 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; } } 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 "off<$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) = @_; 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; }} sub ctx_statement_full { my ($linenr, $remain, $off) = @_; my ($statement, $condition, $level); my (@chunks);Lines 1–500 of 1931. 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.15'; 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 $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, ) 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 @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 ($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 = ''; my $qlen = 0; foreach my $c (split(//, $line)) { # The second backslash of a pair is not a "quote". if ($l eq "\\" && $c eq "\\") { $c = 'X'; } if ($l ne "\\" && ($c eq "'" || $c eq '"')) { if ($quote eq '') { $quote = $c; $res .= $c; $l = $c; $qlen = 0; next; } elsif ($quote eq $c) { $quote = ''; } } if ($quote eq "'" && $qlen > 1) { $quote = ''; } if ($quote && $c ne "\t") { $res .= "X"; $qlen++; } else { $res .= $c; } $l = $c; } # Clear out the comments. while ($res =~ m@(/\*.*?\*/)@g) { substr($res, $-[1], $+[1] - $-[1]) = $; x ($+[1] - $-[1]); } if ($res =~ m@(/\*.*)@) { substr($res, $-[1], $+[1] - $-[1]) = $; x ($+[1] - $-[1]); } if ($res =~ m@^.(.*\*/)@) { substr($res, $-[1], $+[1] - $-[1]) = $; x ($+[1] - $-[1]); } # 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 $loff = 0; my $type = ''; my $level = 0; my $p; my $c; my $len = 0; my $remainder; while (1) { #warn "CSB: blk<$blk>\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>\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 && (!defined($p) || $p =~ /(?:\s|\})/) && $remainder =~ /(else)(?:\s|{)/ && $remainder !~ /else\s+if\b/) { $coff = $off + length($1); } 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; } } 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 "off<$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) = @_; 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; } } sub ctx_statement_full { my ($linenr, $remain, $off) = @_; my ($statement, $condition, $level); my (@chunks);