my $notPermitted = qr{(?: ^(?: $Modifier| $Storage| $Type| DEFINE_\S+ )$| ^(?: goto| return| case| else| asm|__asm__| do| \#| \#\#| )(?:\s|$)| ^(?:typedef|struct|enum)\b )}x; warn "CHECK<$possible> ($line)\n" if ($dbg_possible > 2); if ($possible !~ $notPermitted) { # 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; for my $modifier (split(' ', $possible)) { if ($modifier !~ $notPermitted) { warn "MODIFIER: $modifier ($possible) ($line)\n" if ($dbg_possible); push(@modifierListFile, $modifier); } } } else { warn "POSSIBLE: $possible ($line)\n" if ($dbg_possible); push(@typeListFile, $possible); } build_types(); } else { warn "NOTPOSS: $possible ($line)\n" if ($dbg_possible > 1); }} my $prefix = ''; sub show_type { my ($type) = @_; $type =~ tr/[a-z]/[A-Z]/; return defined $use_type{$type} if (scalar keys %use_type > 0); return !defined $ignore_type{$type};} sub report { my ($level, $type, $msg) = @_; if (!show_type($type) || (defined $tst_only && $msg !~ /\Q$tst_only\E/)) { return 0; } my $output = ''; if ($color) { if ($level eq 'ERROR') { $output .= RED; } elsif ($level eq 'WARNING') { $output .= YELLOW; } else { $output .= GREEN; } } $output .= $prefix . $level . ':'; if ($show_types) { $output .= BLUE if ($color); $output .= "$type:"; } $output .= RESET if ($color); $output .= ' ' . $msg . "\n"; if ($showfile) { my @lines = split("\n", $output, -1); splice(@lines, 1, 1); $output = join("\n", @lines); } $output = (split('\n', $output))[0] . "\n" if ($terse); push(our @report, $output); return 1;} sub report_dump { our @report;} sub fixup_current_range { my ($lineRef, $offset, $length) = @_; if ($$lineRef =~ /^\@\@ -\d+,\d+ \+(\d+),(\d+) \@\@/) { my $o = $1; my $l = $2; my $no = $o + $offset; my $nl = $l + $length; $$lineRef =~ s/\+$o,$l \@\@/\+$no,$nl \@\@/; }} sub fix_inserted_deleted_lines { my ($linesRef, $insertedRef, $deletedRef) = @_; my $range_last_linenr = 0; my $delta_offset = 0; my $old_linenr = 0; my $new_linenr = 0; my $next_insert = 0; my $next_delete = 0; my @lines = (); my $inserted = @{$insertedRef}[$next_insert++]; my $deleted = @{$deletedRef}[$next_delete++]; foreach my $old_line (@{$linesRef}) { my $save_line = 1; my $line = $old_line; #don't modify the array if ($line =~ /^(?:\+\+\+|\-\-\-)\s+\S+/) { #new filename $delta_offset = 0; } elsif ($line =~ /^\@\@ -\d+,\d+ \+\d+,\d+ \@\@/) { #new hunk $range_last_linenr = $new_linenr; fixup_current_range(\$line, $delta_offset, 0); } while (defined($deleted) && ${$deleted}{'LINENR'} == $old_linenr) { $deleted = @{$deletedRef}[$next_delete++]; $save_line = 0; fixup_current_range(\$lines[$range_last_linenr], $delta_offset--, -1); } while (defined($inserted) && ${$inserted}{'LINENR'} == $old_linenr) { push(@lines, ${$inserted}{'LINE'}); $inserted = @{$insertedRef}[$next_insert++]; $new_linenr++; fixup_current_range(\$lines[$range_last_linenr], $delta_offset++, 1); } if ($save_line) { push(@lines, $line); $new_linenr++; } $old_linenr++; } return @lines;} sub fix_insert_line { my ($linenr, $line) = @_; my $inserted = { LINENR => $linenr, LINE => $line, }; push(@fixed_inserted, $inserted);} sub fix_delete_line { my ($linenr, $line) = @_; my $deleted = { LINENR => $linenr, LINE => $line, }; push(@fixed_deleted, $deleted);} sub ERROR { my ($type, $msg) = @_; if (report("ERROR", $type, $msg)) { our $clean = 0; our $cnt_error++; return 1; } return 0;}sub WARN { my ($type, $msg) = @_; if (report("WARNING", $type, $msg)) { our $clean = 0; our $cnt_warn++; return 1; } return 0;}sub CHK { my ($type, $msg) = @_; if ($check && report("CHECK", $type, $msg)) { our $clean = 0; our $cnt_chk++; return 1; } return 0;} 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_PATH", "use relative pathname instead of absolute in changelog text\n" . $herecurr); }} sub trim { my ($string) = @_; $string =~ s/^\s+|\s+$//g; return $string;} sub ltrim { my ($string) = @_; $string =~ s/^\s+//; return $string;} sub rtrim { my ($string) = @_; $string =~ s/\s+$//; return $string;} sub string_find_replace { my ($string, $find, $replace) = @_; $string =~ s/$find/$replace/g; return $string;} sub tabify { my ($leading) = @_; my $source_indent = $tabsize; my $max_spaces_before_tab = $source_indent - 1; my $spaces_to_tab = " " x $source_indent; #convert leading spaces to tabs 1 while $leading =~ s@^([\t]*)$spaces_to_tab@$1\t@g; #Remove spaces before a tab 1 while $leading =~ s@^([\t]*)( {1,$max_spaces_before_tab})\t@$1\t@g; return "$leading";} sub pos_last_openparen { my ($line) = @_; my $pos = 0; my $opens = $line =~ tr/\(/\(/; my $closes = $line =~ tr/\)/\)/; my $last_openparen = 0; if (($opens == 0) || ($closes >= $opens)) { return -1; } my $len = length($line); for ($pos = 0; $pos < $len; $pos++) { my $string = substr($line, $pos); if ($string =~ /^($FuncArg|$balanced_parens)/) { $pos += length($1) - 1; } elsif (substr($line, $pos, 1) eq '(') { $last_openparen = $pos; } elsif (index($string, '(') == -1) { last; } } return length(expand_tabs(substr($line, 0, $last_openparen))) + 1;} sub get_raw_comment { my ($line, $rawline) = @_; my $comment = ''; for my $i (0 .. (length($line) - 1)) { if (substr($line, $i, 1) eq "$;") { $comment .= substr($rawline, $i, 1); } } return $comment;} sub process { my $filename = shift; my $linenr=0; my $prevline=""; my $prevrawline=""; my $stashline=""; my $stashrawline=""; my $length; my $indent; my $previndent=0; my $stashindent=0; our $clean = 1; my $signoff = 0; my $author = ''; my $authorsignoff = 0; my $is_patch = 0; my $is_binding_patch = -1; my $in_header_lines = $file ? 0 : 1; my $in_commit_log = 0; #Scanning lines before patch my $has_patch_separator = 0; #Found a --- line my $has_commit_log = 0; #Encountered lines before patch my $commit_log_lines = 0; #Number of commit log lines my $commit_log_possible_stack_dump = 0; my $commit_log_long_line = 0; my $commit_log_has_diff = 0; my $reported_maintainer_file = 0; my $non_utf8_charset = 0; my $last_blank_line = 0; my $last_coalesced_string_linenr = -1; our @report = (); our $cnt_lines = 0; our $cnt_error = 0; our $cnt_warn = 0; our $cnt_chk = 0; # Trace the real file/line as we go. my $realfile = ''; my $realline = 0; my $realcnt = 0; my $here = ''; my $context_function; #undef'd unless there's a known function my $in_comment = 0; my $comment_edge = 0; my $first_line = 0; my $p1_prefix = ''; my $prev_values = 'E'; # suppression flags my %suppress_ifbraces; my %suppress_whiletrailers; my %suppress_export; my $suppress_statement = 0; my %signatures = (); # Pre-scan the patch sanitizing the lines. # Pre-scan the patch looking for any __setup documentation. # my @setup_docs = (); my $setup_docs = 0; my $camelcase_file_seeded = 0; my $checklicenseline = 1; sanitise_line_reset(); my $line; foreach my $rawline (@rawlines) { $linenr++; $line = $rawline; push(@fixed, $rawline) if ($fix); if ($rawline=~/^\+\+\+\s+(\S+)/) { $setup_docs = 0; if ($1 =~ m@Documentation/admin-guide/kernel-parameters.txt$@) { $setup_docs = 1; } #next; } if ($rawline =~ /^\@\@ -\d+(?:,\d+)? \+(\d+)(,(\d+))? \@\@/) { $realline=$1-1; if (defined $2) { $realcnt=$3+1; } else { $realcnt=1+1; } $in_comment = 0; # Guestimate if this is a continuing comment. Run # the context looking for a comment "edge". If this # edge is a close comment then we must be in a comment # at context start. my $edge; my $cnt = $realcnt; for (my $ln = $linenr + 1; $cnt > 0; $ln++) { next if (defined $rawlines[$ln - 1] && $rawlines[$ln - 1] =~ /^-/); $cnt--; #print "RAW<$rawlines[$ln - 1]>\n"; last if (!defined $rawlines[$ln - 1]); if ($rawlines[$ln - 1] =~ m@(/\*|\*/)@ && $rawlines[$ln - 1] !~ m@"[^"]*(?:/\*|\*/)[^"]*"@) { ($edge) = $1; last; } } if (defined $edge && $edge eq '*/') { $in_comment = 1; } # Guestimate if this is a continuing comment. If this # is the start of a diff block and this line starts # ' *' then it is very likely a comment. if (!defined $edge && $rawlines[$linenr] =~ m@^.\s*(?:\*\*+| \*)(?:\s|$)@) { $in_comment = 1; } ##print "COMMENT:$in_comment edge<$edge> $rawline\n"; sanitise_line_reset($in_comment); } elsif ($realcnt && $rawline =~ /^(?:\+| |$)/) { # Standardise the strings and chars within the input to # simplify matching -- only bother with positive lines. $line = sanitise_line($rawline); } push(@lines, $line); if ($realcnt > 1) { $realcnt-- if ($line =~ /^(?:\+| |$)/); } else { $realcnt = 0; } #print "==>$rawline\n"; #print "-->$line\n"; if ($setup_docs && $line =~ /^\+/) { push(@setup_docs, $line); } } $prefix = ''; $realcnt = 0; $linenr = 0; $fixlinenr = -1; foreach my $line (@lines) { $linenr++; $fixlinenr++; my $sline = $line; #copy of $line $sline =~ s/$;/ /g; #with comments as spaces my $rawline = $rawlines[$linenr - 1]; my $raw_comment = get_raw_comment($line, $rawline); # check if it's a mode change, rename or start of a patch if (!$in_commit_log && ($line =~ /^ mode change [0-7]+ => [0-7]+ \S+\s*$/ || ($line =~ /^rename (?:from|to) \S+\s*$/ || $line =~ /^diff --git a\/[\w\/\.\_\-]+ b\/\S+\s*$/))) {Lines 2001–2500 of 6972. Previous lines Load more
my $notPermitted = qr{(?: ^(?: $Modifier| $Storage| $Type| DEFINE_\S+ )$| ^(?: goto| return| case| else| asm|__asm__| do| \#| \#\#| )(?:\s|$)| ^(?:typedef|struct|enum)\b )}x; warn "CHECK<$possible> ($line)\n" if ($dbg_possible > 2); if ($possible !~ $notPermitted) { # 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; for my $modifier (split(' ', $possible)) { if ($modifier !~ $notPermitted) { warn "MODIFIER: $modifier ($possible) ($line)\n" if ($dbg_possible); push(@modifierListFile, $modifier); } } } else { warn "POSSIBLE: $possible ($line)\n" if ($dbg_possible); push(@typeListFile, $possible); } build_types(); } else { warn "NOTPOSS: $possible ($line)\n" if ($dbg_possible > 1); } } my $prefix = ''; sub show_type { my ($type) = @_; $type =~ tr/[a-z]/[A-Z]/; return defined $use_type{$type} if (scalar keys %use_type > 0); return !defined $ignore_type{$type}; } sub report { my ($level, $type, $msg) = @_; if (!show_type($type) || (defined $tst_only && $msg !~ /\Q$tst_only\E/)) { return 0; } my $output = ''; if ($color) { if ($level eq 'ERROR') { $output .= RED; } elsif ($level eq 'WARNING') { $output .= YELLOW; } else { $output .= GREEN; } } $output .= $prefix . $level . ':'; if ($show_types) { $output .= BLUE if ($color); $output .= "$type:"; } $output .= RESET if ($color); $output .= ' ' . $msg . "\n"; if ($showfile) { my @lines = split("\n", $output, -1); splice(@lines, 1, 1); $output = join("\n", @lines); } $output = (split('\n', $output))[0] . "\n" if ($terse); push(our @report, $output); return 1; } sub report_dump { our @report; } sub fixup_current_range { my ($lineRef, $offset, $length) = @_; if ($$lineRef =~ /^\@\@ -\d+,\d+ \+(\d+),(\d+) \@\@/) { my $o = $1; my $l = $2; my $no = $o + $offset; my $nl = $l + $length; $$lineRef =~ s/\+$o,$l \@\@/\+$no,$nl \@\@/; } } sub fix_inserted_deleted_lines { my ($linesRef, $insertedRef, $deletedRef) = @_; my $range_last_linenr = 0; my $delta_offset = 0; my $old_linenr = 0; my $new_linenr = 0; my $next_insert = 0; my $next_delete = 0; my @lines = (); my $inserted = @{$insertedRef}[$next_insert++]; my $deleted = @{$deletedRef}[$next_delete++]; foreach my $old_line (@{$linesRef}) { my $save_line = 1; my $line = $old_line; #don't modify the array if ($line =~ /^(?:\+\+\+|\-\-\-)\s+\S+/) { #new filename $delta_offset = 0; } elsif ($line =~ /^\@\@ -\d+,\d+ \+\d+,\d+ \@\@/) { #new hunk $range_last_linenr = $new_linenr; fixup_current_range(\$line, $delta_offset, 0); } while (defined($deleted) && ${$deleted}{'LINENR'} == $old_linenr) { $deleted = @{$deletedRef}[$next_delete++]; $save_line = 0; fixup_current_range(\$lines[$range_last_linenr], $delta_offset--, -1); } while (defined($inserted) && ${$inserted}{'LINENR'} == $old_linenr) { push(@lines, ${$inserted}{'LINE'}); $inserted = @{$insertedRef}[$next_insert++]; $new_linenr++; fixup_current_range(\$lines[$range_last_linenr], $delta_offset++, 1); } if ($save_line) { push(@lines, $line); $new_linenr++; } $old_linenr++; } return @lines; } sub fix_insert_line { my ($linenr, $line) = @_; my $inserted = { LINENR => $linenr, LINE => $line, }; push(@fixed_inserted, $inserted); } sub fix_delete_line { my ($linenr, $line) = @_; my $deleted = { LINENR => $linenr, LINE => $line, }; push(@fixed_deleted, $deleted); } sub ERROR { my ($type, $msg) = @_; if (report("ERROR", $type, $msg)) { our $clean = 0; our $cnt_error++; return 1; } return 0; } sub WARN { my ($type, $msg) = @_; if (report("WARNING", $type, $msg)) { our $clean = 0; our $cnt_warn++; return 1; } return 0; } sub CHK { my ($type, $msg) = @_; if ($check && report("CHECK", $type, $msg)) { our $clean = 0; our $cnt_chk++; return 1; } return 0; } 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_PATH", "use relative pathname instead of absolute in changelog text\n" . $herecurr); } } sub trim { my ($string) = @_; $string =~ s/^\s+|\s+$//g; return $string; } sub ltrim { my ($string) = @_; $string =~ s/^\s+//; return $string; } sub rtrim { my ($string) = @_; $string =~ s/\s+$//; return $string; } sub string_find_replace { my ($string, $find, $replace) = @_; $string =~ s/$find/$replace/g; return $string; } sub tabify { my ($leading) = @_; my $source_indent = $tabsize; my $max_spaces_before_tab = $source_indent - 1; my $spaces_to_tab = " " x $source_indent; #convert leading spaces to tabs 1 while $leading =~ s@^([\t]*)$spaces_to_tab@$1\t@g; #Remove spaces before a tab 1 while $leading =~ s@^([\t]*)( {1,$max_spaces_before_tab})\t@$1\t@g; return "$leading"; } sub pos_last_openparen { my ($line) = @_; my $pos = 0; my $opens = $line =~ tr/\(/\(/; my $closes = $line =~ tr/\)/\)/; my $last_openparen = 0; if (($opens == 0) || ($closes >= $opens)) { return -1; } my $len = length($line); for ($pos = 0; $pos < $len; $pos++) { my $string = substr($line, $pos); if ($string =~ /^($FuncArg|$balanced_parens)/) { $pos += length($1) - 1; } elsif (substr($line, $pos, 1) eq '(') { $last_openparen = $pos; } elsif (index($string, '(') == -1) { last; } } return length(expand_tabs(substr($line, 0, $last_openparen))) + 1; } sub get_raw_comment { my ($line, $rawline) = @_; my $comment = ''; for my $i (0 .. (length($line) - 1)) { if (substr($line, $i, 1) eq "$;") { $comment .= substr($rawline, $i, 1); } } return $comment; } sub process { my $filename = shift; my $linenr=0; my $prevline=""; my $prevrawline=""; my $stashline=""; my $stashrawline=""; my $length; my $indent; my $previndent=0; my $stashindent=0; our $clean = 1; my $signoff = 0; my $author = ''; my $authorsignoff = 0; my $is_patch = 0; my $is_binding_patch = -1; my $in_header_lines = $file ? 0 : 1; my $in_commit_log = 0; #Scanning lines before patch my $has_patch_separator = 0; #Found a --- line my $has_commit_log = 0; #Encountered lines before patch my $commit_log_lines = 0; #Number of commit log lines my $commit_log_possible_stack_dump = 0; my $commit_log_long_line = 0; my $commit_log_has_diff = 0; my $reported_maintainer_file = 0; my $non_utf8_charset = 0; my $last_blank_line = 0; my $last_coalesced_string_linenr = -1; our @report = (); our $cnt_lines = 0; our $cnt_error = 0; our $cnt_warn = 0; our $cnt_chk = 0; # Trace the real file/line as we go. my $realfile = ''; my $realline = 0; my $realcnt = 0; my $here = ''; my $context_function; #undef'd unless there's a known function my $in_comment = 0; my $comment_edge = 0; my $first_line = 0; my $p1_prefix = ''; my $prev_values = 'E'; # suppression flags my %suppress_ifbraces; my %suppress_whiletrailers; my %suppress_export; my $suppress_statement = 0; my %signatures = (); # Pre-scan the patch sanitizing the lines. # Pre-scan the patch looking for any __setup documentation. # my @setup_docs = (); my $setup_docs = 0; my $camelcase_file_seeded = 0; my $checklicenseline = 1; sanitise_line_reset(); my $line; foreach my $rawline (@rawlines) { $linenr++; $line = $rawline; push(@fixed, $rawline) if ($fix); if ($rawline=~/^\+\+\+\s+(\S+)/) { $setup_docs = 0; if ($1 =~ m@Documentation/admin-guide/kernel-parameters.txt$@) { $setup_docs = 1; } #next; } if ($rawline =~ /^\@\@ -\d+(?:,\d+)? \+(\d+)(,(\d+))? \@\@/) { $realline=$1-1; if (defined $2) { $realcnt=$3+1; } else { $realcnt=1+1; } $in_comment = 0; # Guestimate if this is a continuing comment. Run # the context looking for a comment "edge". If this # edge is a close comment then we must be in a comment # at context start. my $edge; my $cnt = $realcnt; for (my $ln = $linenr + 1; $cnt > 0; $ln++) { next if (defined $rawlines[$ln - 1] && $rawlines[$ln - 1] =~ /^-/); $cnt--; #print "RAW<$rawlines[$ln - 1]>\n"; last if (!defined $rawlines[$ln - 1]); if ($rawlines[$ln - 1] =~ m@(/\*|\*/)@ && $rawlines[$ln - 1] !~ m@"[^"]*(?:/\*|\*/)[^"]*"@) { ($edge) = $1; last; } } if (defined $edge && $edge eq '*/') { $in_comment = 1; } # Guestimate if this is a continuing comment. If this # is the start of a diff block and this line starts # ' *' then it is very likely a comment. if (!defined $edge && $rawlines[$linenr] =~ m@^.\s*(?:\*\*+| \*)(?:\s|$)@) { $in_comment = 1; } ##print "COMMENT:$in_comment edge<$edge> $rawline\n"; sanitise_line_reset($in_comment); } elsif ($realcnt && $rawline =~ /^(?:\+| |$)/) { # Standardise the strings and chars within the input to # simplify matching -- only bother with positive lines. $line = sanitise_line($rawline); } push(@lines, $line); if ($realcnt > 1) { $realcnt-- if ($line =~ /^(?:\+| |$)/); } else { $realcnt = 0; } #print "==>$rawline\n"; #print "-->$line\n"; if ($setup_docs && $line =~ /^\+/) { push(@setup_docs, $line); } } $prefix = ''; $realcnt = 0; $linenr = 0; $fixlinenr = -1; foreach my $line (@lines) { $linenr++; $fixlinenr++; my $sline = $line; #copy of $line $sline =~ s/$;/ /g; #with comments as spaces my $rawline = $rawlines[$linenr - 1]; my $raw_comment = get_raw_comment($line, $rawline); # check if it's a mode change, rename or start of a patch if (!$in_commit_log && ($line =~ /^ mode change [0-7]+ => [0-7]+ \S+\s*$/ || ($line =~ /^rename (?:from|to) \S+\s*$/ || $line =~ /^diff --git a\/[\w\/\.\_\-]+ b\/\S+\s*$/))) {