developer | 2cdaeb1 | 2022-10-04 20:25:05 +0800 | [diff] [blame] | 1 | #!/usr/bin/env perl |
| 2 | # SPDX-License-Identifier: GPL-2.0 |
| 3 | # |
| 4 | # (c) 2001, Dave Jones. (the file handling bit) |
| 5 | # (c) 2005, Joel Schopp <jschopp@austin.ibm.com> (the ugly bit) |
| 6 | # (c) 2007,2008, Andy Whitcroft <apw@uk.ibm.com> (new conditions, test suite) |
| 7 | # (c) 2008-2010 Andy Whitcroft <apw@canonical.com> |
| 8 | # (c) 2010-2018 Joe Perches <joe@perches.com> |
| 9 | |
| 10 | use strict; |
| 11 | use warnings; |
| 12 | use POSIX; |
| 13 | use File::Basename; |
| 14 | use Cwd 'abs_path'; |
| 15 | use Term::ANSIColor qw(:constants); |
| 16 | use Encode qw(decode encode); |
| 17 | |
| 18 | my $P = $0; |
| 19 | my $D = dirname(abs_path($P)); |
| 20 | |
| 21 | my $V = '0.32'; |
| 22 | |
| 23 | use Getopt::Long qw(:config no_auto_abbrev); |
| 24 | |
| 25 | my $quiet = 0; |
| 26 | my $tree = 1; |
| 27 | my $chk_signoff = 1; |
| 28 | my $chk_patch = 1; |
| 29 | my $tst_only; |
| 30 | my $emacs = 0; |
| 31 | my $terse = 0; |
| 32 | my $showfile = 0; |
| 33 | my $file = 0; |
| 34 | my $git = 0; |
| 35 | my %git_commits = (); |
| 36 | my $check = 0; |
| 37 | my $check_orig = 0; |
| 38 | my $summary = 1; |
| 39 | my $mailback = 0; |
| 40 | my $summary_file = 0; |
| 41 | my $show_types = 0; |
| 42 | my $list_types = 0; |
| 43 | my $fix = 0; |
| 44 | my $fix_inplace = 0; |
| 45 | my $root; |
| 46 | my %debug; |
| 47 | my %camelcase = (); |
| 48 | my %use_type = (); |
| 49 | my @use = (); |
| 50 | my %ignore_type = (); |
| 51 | my @ignore = (); |
| 52 | my $help = 0; |
| 53 | my $configuration_file = ".checkpatch.conf"; |
| 54 | my $max_line_length = 80; |
| 55 | my $ignore_perl_version = 0; |
| 56 | my $minimum_perl_version = 5.10.0; |
| 57 | my $min_conf_desc_length = 4; |
| 58 | my $spelling_file = "$D/spelling.txt"; |
| 59 | my $codespell = 0; |
| 60 | my $codespellfile = "/usr/share/codespell/dictionary.txt"; |
| 61 | my $conststructsfile = "$D/const_structs.checkpatch"; |
| 62 | my $typedefsfile = ""; |
| 63 | my $color = "auto"; |
| 64 | my $allow_c99_comments = 1; # Can be overridden by --ignore C99_COMMENT_TOLERANCE |
| 65 | # git output parsing needs US English output, so first set backtick child process LANGUAGE |
| 66 | my $git_command ='export LANGUAGE=en_US.UTF-8; git'; |
| 67 | |
| 68 | sub help { |
| 69 | my ($exitcode) = @_; |
| 70 | |
| 71 | print << "EOM"; |
| 72 | Usage: $P [OPTION]... [FILE]... |
| 73 | Version: $V |
| 74 | |
| 75 | Options: |
| 76 | -q, --quiet quiet |
| 77 | --no-tree run without a kernel tree |
| 78 | --no-signoff do not check for 'Signed-off-by' line |
| 79 | --patch treat FILE as patchfile (default) |
| 80 | --emacs emacs compile window format |
| 81 | --terse one line per report |
| 82 | --showfile emit diffed file position, not input file position |
| 83 | -g, --git treat FILE as a single commit or git revision range |
| 84 | single git commit with: |
| 85 | <rev> |
| 86 | <rev>^ |
| 87 | <rev>~n |
| 88 | multiple git commits with: |
| 89 | <rev1>..<rev2> |
| 90 | <rev1>...<rev2> |
| 91 | <rev>-<count> |
| 92 | git merges are ignored |
| 93 | -f, --file treat FILE as regular source file |
| 94 | --subjective, --strict enable more subjective tests |
| 95 | --list-types list the possible message types |
| 96 | --types TYPE(,TYPE2...) show only these comma separated message types |
| 97 | --ignore TYPE(,TYPE2...) ignore various comma separated message types |
| 98 | --show-types show the specific message type in the output |
| 99 | --max-line-length=n set the maximum line length, if exceeded, warn |
| 100 | --min-conf-desc-length=n set the min description length, if shorter, warn |
| 101 | --root=PATH PATH to the kernel tree root |
| 102 | --no-summary suppress the per-file summary |
| 103 | --mailback only produce a report in case of warnings/errors |
| 104 | --summary-file include the filename in summary |
| 105 | --debug KEY=[0|1] turn on/off debugging of KEY, where KEY is one of |
| 106 | 'values', 'possible', 'type', and 'attr' (default |
| 107 | is all off) |
| 108 | --test-only=WORD report only warnings/errors containing WORD |
| 109 | literally |
| 110 | --fix EXPERIMENTAL - may create horrible results |
| 111 | If correctable single-line errors exist, create |
| 112 | "<inputfile>.EXPERIMENTAL-checkpatch-fixes" |
| 113 | with potential errors corrected to the preferred |
| 114 | checkpatch style |
| 115 | --fix-inplace EXPERIMENTAL - may create horrible results |
| 116 | Is the same as --fix, but overwrites the input |
| 117 | file. It's your fault if there's no backup or git |
| 118 | --ignore-perl-version override checking of perl version. expect |
| 119 | runtime errors. |
| 120 | --codespell Use the codespell dictionary for spelling/typos |
| 121 | (default:/usr/share/codespell/dictionary.txt) |
| 122 | --codespellfile Use this codespell dictionary |
| 123 | --typedefsfile Read additional types from this file |
| 124 | --color[=WHEN] Use colors 'always', 'never', or only when output |
| 125 | is a terminal ('auto'). Default is 'auto'. |
| 126 | -h, --help, --version display this help and exit |
| 127 | |
| 128 | When FILE is - read standard input. |
| 129 | EOM |
| 130 | |
| 131 | exit($exitcode); |
| 132 | } |
| 133 | |
| 134 | sub uniq { |
| 135 | my %seen; |
| 136 | return grep { !$seen{$_}++ } @_; |
| 137 | } |
| 138 | |
| 139 | sub list_types { |
| 140 | my ($exitcode) = @_; |
| 141 | |
| 142 | my $count = 0; |
| 143 | |
| 144 | local $/ = undef; |
| 145 | |
| 146 | open(my $script, '<', abs_path($P)) or |
| 147 | die "$P: Can't read '$P' $!\n"; |
| 148 | |
| 149 | my $text = <$script>; |
| 150 | close($script); |
| 151 | |
| 152 | my @types = (); |
| 153 | # Also catch when type or level is passed through a variable |
| 154 | for ($text =~ /(?:(?:\bCHK|\bWARN|\bERROR|&\{\$msg_level})\s*\(|\$msg_type\s*=)\s*"([^"]+)"/g) { |
| 155 | push (@types, $_); |
| 156 | } |
| 157 | @types = sort(uniq(@types)); |
| 158 | print("#\tMessage type\n\n"); |
| 159 | foreach my $type (@types) { |
| 160 | print(++$count . "\t" . $type . "\n"); |
| 161 | } |
| 162 | |
| 163 | exit($exitcode); |
| 164 | } |
| 165 | |
| 166 | my $conf = which_conf($configuration_file); |
| 167 | if (-f $conf) { |
| 168 | my @conf_args; |
| 169 | open(my $conffile, '<', "$conf") |
| 170 | or warn "$P: Can't find a readable $configuration_file file $!\n"; |
| 171 | |
| 172 | while (<$conffile>) { |
| 173 | my $line = $_; |
| 174 | |
| 175 | $line =~ s/\s*\n?$//g; |
| 176 | $line =~ s/^\s*//g; |
| 177 | $line =~ s/\s+/ /g; |
| 178 | |
| 179 | next if ($line =~ m/^\s*#/); |
| 180 | next if ($line =~ m/^\s*$/); |
| 181 | |
| 182 | my @words = split(" ", $line); |
| 183 | foreach my $word (@words) { |
| 184 | last if ($word =~ m/^#/); |
| 185 | push (@conf_args, $word); |
| 186 | } |
| 187 | } |
| 188 | close($conffile); |
| 189 | unshift(@ARGV, @conf_args) if @conf_args; |
| 190 | } |
| 191 | |
| 192 | # Perl's Getopt::Long allows options to take optional arguments after a space. |
| 193 | # Prevent --color by itself from consuming other arguments |
| 194 | foreach (@ARGV) { |
| 195 | if ($_ eq "--color" || $_ eq "-color") { |
| 196 | $_ = "--color=$color"; |
| 197 | } |
| 198 | } |
| 199 | |
| 200 | GetOptions( |
| 201 | 'q|quiet+' => \$quiet, |
| 202 | 'tree!' => \$tree, |
| 203 | 'signoff!' => \$chk_signoff, |
| 204 | 'patch!' => \$chk_patch, |
| 205 | 'emacs!' => \$emacs, |
| 206 | 'terse!' => \$terse, |
| 207 | 'showfile!' => \$showfile, |
| 208 | 'f|file!' => \$file, |
| 209 | 'g|git!' => \$git, |
| 210 | 'subjective!' => \$check, |
| 211 | 'strict!' => \$check, |
| 212 | 'ignore=s' => \@ignore, |
| 213 | 'types=s' => \@use, |
| 214 | 'show-types!' => \$show_types, |
| 215 | 'list-types!' => \$list_types, |
| 216 | 'max-line-length=i' => \$max_line_length, |
| 217 | 'min-conf-desc-length=i' => \$min_conf_desc_length, |
| 218 | 'root=s' => \$root, |
| 219 | 'summary!' => \$summary, |
| 220 | 'mailback!' => \$mailback, |
| 221 | 'summary-file!' => \$summary_file, |
| 222 | 'fix!' => \$fix, |
| 223 | 'fix-inplace!' => \$fix_inplace, |
| 224 | 'ignore-perl-version!' => \$ignore_perl_version, |
| 225 | 'debug=s' => \%debug, |
| 226 | 'test-only=s' => \$tst_only, |
| 227 | 'codespell!' => \$codespell, |
| 228 | 'codespellfile=s' => \$codespellfile, |
| 229 | 'typedefsfile=s' => \$typedefsfile, |
| 230 | 'color=s' => \$color, |
| 231 | 'no-color' => \$color, #keep old behaviors of -nocolor |
| 232 | 'nocolor' => \$color, #keep old behaviors of -nocolor |
| 233 | 'h|help' => \$help, |
| 234 | 'version' => \$help |
| 235 | ) or help(1); |
| 236 | |
| 237 | help(0) if ($help); |
| 238 | |
| 239 | list_types(0) if ($list_types); |
| 240 | |
| 241 | $fix = 1 if ($fix_inplace); |
| 242 | $check_orig = $check; |
| 243 | |
| 244 | my $exit = 0; |
| 245 | |
| 246 | my $perl_version_ok = 1; |
| 247 | if ($^V && $^V lt $minimum_perl_version) { |
| 248 | $perl_version_ok = 0; |
| 249 | printf "$P: requires at least perl version %vd\n", $minimum_perl_version; |
| 250 | exit(1) if (!$ignore_perl_version); |
| 251 | } |
| 252 | |
| 253 | #if no filenames are given, push '-' to read patch from stdin |
| 254 | if ($#ARGV < 0) { |
| 255 | push(@ARGV, '-'); |
| 256 | } |
| 257 | |
| 258 | if ($color =~ /^[01]$/) { |
| 259 | $color = !$color; |
| 260 | } elsif ($color =~ /^always$/i) { |
| 261 | $color = 1; |
| 262 | } elsif ($color =~ /^never$/i) { |
| 263 | $color = 0; |
| 264 | } elsif ($color =~ /^auto$/i) { |
| 265 | $color = (-t STDOUT); |
| 266 | } else { |
| 267 | die "Invalid color mode: $color\n"; |
| 268 | } |
| 269 | |
| 270 | sub hash_save_array_words { |
| 271 | my ($hashRef, $arrayRef) = @_; |
| 272 | |
| 273 | my @array = split(/,/, join(',', @$arrayRef)); |
| 274 | foreach my $word (@array) { |
| 275 | $word =~ s/\s*\n?$//g; |
| 276 | $word =~ s/^\s*//g; |
| 277 | $word =~ s/\s+/ /g; |
| 278 | $word =~ tr/[a-z]/[A-Z]/; |
| 279 | |
| 280 | next if ($word =~ m/^\s*#/); |
| 281 | next if ($word =~ m/^\s*$/); |
| 282 | |
| 283 | $hashRef->{$word}++; |
| 284 | } |
| 285 | } |
| 286 | |
| 287 | sub hash_show_words { |
| 288 | my ($hashRef, $prefix) = @_; |
| 289 | |
| 290 | if (keys %$hashRef) { |
| 291 | print "\nNOTE: $prefix message types:"; |
| 292 | foreach my $word (sort keys %$hashRef) { |
| 293 | print " $word"; |
| 294 | } |
| 295 | print "\n"; |
| 296 | } |
| 297 | } |
| 298 | |
| 299 | hash_save_array_words(\%ignore_type, \@ignore); |
| 300 | hash_save_array_words(\%use_type, \@use); |
| 301 | |
| 302 | my $dbg_values = 0; |
| 303 | my $dbg_possible = 0; |
| 304 | my $dbg_type = 0; |
| 305 | my $dbg_attr = 0; |
| 306 | for my $key (keys %debug) { |
| 307 | ## no critic |
| 308 | eval "\${dbg_$key} = '$debug{$key}';"; |
| 309 | die "$@" if ($@); |
| 310 | } |
| 311 | |
| 312 | my $rpt_cleaners = 0; |
| 313 | |
| 314 | if ($terse) { |
| 315 | $emacs = 1; |
| 316 | $quiet++; |
| 317 | } |
| 318 | |
| 319 | if ($tree) { |
| 320 | if (defined $root) { |
| 321 | if (!top_of_kernel_tree($root)) { |
| 322 | die "$P: $root: --root does not point at a valid tree\n"; |
| 323 | } |
| 324 | } else { |
| 325 | if (top_of_kernel_tree('.')) { |
| 326 | $root = '.'; |
| 327 | } elsif ($0 =~ m@(.*)/scripts/[^/]*$@ && |
| 328 | top_of_kernel_tree($1)) { |
| 329 | $root = $1; |
| 330 | } |
| 331 | } |
| 332 | |
| 333 | if (!defined $root) { |
| 334 | print "Must be run from the top-level dir. of a kernel tree\n"; |
| 335 | exit(2); |
| 336 | } |
| 337 | } |
| 338 | |
| 339 | my $emitted_corrupt = 0; |
| 340 | |
| 341 | our $Ident = qr{ |
| 342 | [A-Za-z_][A-Za-z\d_]* |
| 343 | (?:\s*\#\#\s*[A-Za-z_][A-Za-z\d_]*)* |
| 344 | }x; |
| 345 | our $Storage = qr{extern|static|asmlinkage}; |
| 346 | our $Sparse = qr{ |
| 347 | __user| |
| 348 | __kernel| |
| 349 | __force| |
| 350 | __iomem| |
| 351 | __must_check| |
| 352 | __kprobes| |
| 353 | __ref| |
| 354 | __refconst| |
| 355 | __refdata| |
| 356 | __rcu| |
| 357 | __private |
| 358 | }x; |
| 359 | our $InitAttributePrefix = qr{__(?:mem|cpu|dev|net_|)}; |
| 360 | our $InitAttributeData = qr{$InitAttributePrefix(?:initdata\b)}; |
| 361 | our $InitAttributeConst = qr{$InitAttributePrefix(?:initconst\b)}; |
| 362 | our $InitAttributeInit = qr{$InitAttributePrefix(?:init\b)}; |
| 363 | our $InitAttribute = qr{$InitAttributeData|$InitAttributeConst|$InitAttributeInit}; |
| 364 | |
| 365 | # Notes to $Attribute: |
| 366 | # We need \b after 'init' otherwise 'initconst' will cause a false positive in a check |
| 367 | our $Attribute = qr{ |
| 368 | const| |
| 369 | __percpu| |
| 370 | __nocast| |
| 371 | __safe| |
| 372 | __bitwise| |
| 373 | __packed__| |
| 374 | __packed2__| |
| 375 | __naked| |
| 376 | __maybe_unused| |
| 377 | __always_unused| |
| 378 | __noreturn| |
| 379 | __used| |
| 380 | __cold| |
| 381 | __pure| |
| 382 | __noclone| |
| 383 | __deprecated| |
| 384 | __read_mostly| |
| 385 | __ro_after_init| |
| 386 | __kprobes| |
| 387 | $InitAttribute| |
| 388 | ____cacheline_aligned| |
| 389 | ____cacheline_aligned_in_smp| |
| 390 | ____cacheline_internodealigned_in_smp| |
| 391 | __weak |
| 392 | }x; |
| 393 | our $Modifier; |
| 394 | our $Inline = qr{inline|__always_inline|noinline|__inline|__inline__}; |
| 395 | our $Member = qr{->$Ident|\.$Ident|\[[^]]*\]}; |
| 396 | our $Lval = qr{$Ident(?:$Member)*}; |
| 397 | |
| 398 | our $Int_type = qr{(?i)llu|ull|ll|lu|ul|l|u}; |
| 399 | our $Binary = qr{(?i)0b[01]+$Int_type?}; |
| 400 | our $Hex = qr{(?i)0x[0-9a-f]+$Int_type?}; |
| 401 | our $Int = qr{[0-9]+$Int_type?}; |
| 402 | our $Octal = qr{0[0-7]+$Int_type?}; |
| 403 | our $String = qr{"[X\t]*"}; |
| 404 | our $Float_hex = qr{(?i)0x[0-9a-f]+p-?[0-9]+[fl]?}; |
| 405 | our $Float_dec = qr{(?i)(?:[0-9]+\.[0-9]*|[0-9]*\.[0-9]+)(?:e-?[0-9]+)?[fl]?}; |
| 406 | our $Float_int = qr{(?i)[0-9]+e-?[0-9]+[fl]?}; |
| 407 | our $Float = qr{$Float_hex|$Float_dec|$Float_int}; |
| 408 | our $Constant = qr{$Float|$Binary|$Octal|$Hex|$Int}; |
| 409 | our $Assignment = qr{\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=}; |
| 410 | our $Compare = qr{<=|>=|==|!=|<|(?<!-)>}; |
| 411 | our $Arithmetic = qr{\+|-|\*|\/|%}; |
| 412 | our $Operators = qr{ |
| 413 | <=|>=|==|!=| |
| 414 | =>|->|<<|>>|<|>|!|~| |
| 415 | &&|\|\||,|\^|\+\+|--|&|\||$Arithmetic |
| 416 | }x; |
| 417 | |
| 418 | our $c90_Keywords = qr{do|for|while|if|else|return|goto|continue|switch|default|case|break}x; |
| 419 | |
| 420 | our $BasicType; |
| 421 | our $NonptrType; |
| 422 | our $NonptrTypeMisordered; |
| 423 | our $NonptrTypeWithAttr; |
| 424 | our $Type; |
| 425 | our $TypeMisordered; |
| 426 | our $Declare; |
| 427 | our $DeclareMisordered; |
| 428 | |
| 429 | our $NON_ASCII_UTF8 = qr{ |
| 430 | [\xC2-\xDF][\x80-\xBF] # non-overlong 2-byte |
| 431 | | \xE0[\xA0-\xBF][\x80-\xBF] # excluding overlongs |
| 432 | | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2} # straight 3-byte |
| 433 | | \xED[\x80-\x9F][\x80-\xBF] # excluding surrogates |
| 434 | | \xF0[\x90-\xBF][\x80-\xBF]{2} # planes 1-3 |
| 435 | | [\xF1-\xF3][\x80-\xBF]{3} # planes 4-15 |
| 436 | | \xF4[\x80-\x8F][\x80-\xBF]{2} # plane 16 |
| 437 | }x; |
| 438 | |
| 439 | our $UTF8 = qr{ |
| 440 | [\x09\x0A\x0D\x20-\x7E] # ASCII |
| 441 | | $NON_ASCII_UTF8 |
| 442 | }x; |
| 443 | |
| 444 | our $typeC99Typedefs = qr{(?:__)?(?:[us]_?)?int_?(?:8|16|32|64)_t}; |
| 445 | our $typeOtherOSTypedefs = qr{(?x: |
| 446 | u_(?:char|short|int|long) | # bsd |
| 447 | u(?:nchar|short|int|long) # sysv |
| 448 | )}; |
| 449 | our $typeKernelTypedefs = qr{(?x: |
| 450 | (?:__)?(?:u|s|be|le)(?:8|16|32|64)| |
| 451 | atomic_t |
| 452 | )}; |
| 453 | our $typeTypedefs = qr{(?x: |
| 454 | $typeC99Typedefs\b| |
| 455 | $typeOtherOSTypedefs\b| |
| 456 | $typeKernelTypedefs\b |
| 457 | )}; |
| 458 | |
| 459 | our $zero_initializer = qr{(?:(?:0[xX])?0+$Int_type?|NULL|false)\b}; |
| 460 | |
| 461 | our $logFunctions = qr{(?x: |
| 462 | printk(?:_ratelimited|_once|_deferred_once|_deferred|)| |
| 463 | (?:[a-z0-9]+_){1,2}(?:printk|emerg|alert|crit|err|warning|warn|notice|info|debug|dbg|vdbg|devel|cont|WARN)(?:_ratelimited|_once|)| |
| 464 | TP_printk| |
| 465 | WARN(?:_RATELIMIT|_ONCE|)| |
| 466 | panic| |
| 467 | MODULE_[A-Z_]+| |
| 468 | seq_vprintf|seq_printf|seq_puts |
| 469 | )}; |
| 470 | |
| 471 | our $allocFunctions = qr{(?x: |
| 472 | (?:(?:devm_)? |
| 473 | (?:kv|k|v)[czm]alloc(?:_node|_array)? | |
| 474 | kstrdup(?:_const)? | |
| 475 | kmemdup(?:_nul)?) | |
| 476 | (?:\w+)?alloc_skb(?:ip_align)? | |
| 477 | # dev_alloc_skb/netdev_alloc_skb, et al |
| 478 | dma_alloc_coherent |
| 479 | )}; |
| 480 | |
| 481 | our $signature_tags = qr{(?xi: |
| 482 | Signed-off-by:| |
| 483 | Co-developed-by:| |
| 484 | Acked-by:| |
| 485 | Tested-by:| |
| 486 | Reviewed-by:| |
| 487 | Reported-by:| |
| 488 | Suggested-by:| |
| 489 | To:| |
| 490 | Cc: |
| 491 | )}; |
| 492 | |
| 493 | our @typeListMisordered = ( |
| 494 | qr{char\s+(?:un)?signed}, |
| 495 | qr{int\s+(?:(?:un)?signed\s+)?short\s}, |
| 496 | qr{int\s+short(?:\s+(?:un)?signed)}, |
| 497 | qr{short\s+int(?:\s+(?:un)?signed)}, |
| 498 | qr{(?:un)?signed\s+int\s+short}, |
| 499 | qr{short\s+(?:un)?signed}, |
| 500 | qr{long\s+int\s+(?:un)?signed}, |
| 501 | qr{int\s+long\s+(?:un)?signed}, |
| 502 | qr{long\s+(?:un)?signed\s+int}, |
| 503 | qr{int\s+(?:un)?signed\s+long}, |
| 504 | qr{int\s+(?:un)?signed}, |
| 505 | qr{int\s+long\s+long\s+(?:un)?signed}, |
| 506 | qr{long\s+long\s+int\s+(?:un)?signed}, |
| 507 | qr{long\s+long\s+(?:un)?signed\s+int}, |
| 508 | qr{long\s+long\s+(?:un)?signed}, |
| 509 | qr{long\s+(?:un)?signed}, |
| 510 | ); |
| 511 | |
| 512 | our @typeList = ( |
| 513 | qr{void}, |
| 514 | qr{(?:(?:un)?signed\s+)?char}, |
| 515 | qr{(?:(?:un)?signed\s+)?short\s+int}, |
| 516 | qr{(?:(?:un)?signed\s+)?short}, |
| 517 | qr{(?:(?:un)?signed\s+)?int}, |
| 518 | qr{(?:(?:un)?signed\s+)?long\s+int}, |
| 519 | qr{(?:(?:un)?signed\s+)?long\s+long\s+int}, |
| 520 | qr{(?:(?:un)?signed\s+)?long\s+long}, |
| 521 | qr{(?:(?:un)?signed\s+)?long}, |
| 522 | qr{(?:un)?signed}, |
| 523 | qr{float}, |
| 524 | qr{double}, |
| 525 | qr{bool}, |
| 526 | qr{struct\s+$Ident}, |
| 527 | qr{union\s+$Ident}, |
| 528 | qr{enum\s+$Ident}, |
| 529 | qr{${Ident}_t}, |
| 530 | qr{${Ident}_handler}, |
| 531 | qr{${Ident}_handler_fn}, |
| 532 | @typeListMisordered, |
| 533 | ); |
| 534 | |
| 535 | our $C90_int_types = qr{(?x: |
| 536 | long\s+long\s+int\s+(?:un)?signed| |
| 537 | long\s+long\s+(?:un)?signed\s+int| |
| 538 | long\s+long\s+(?:un)?signed| |
| 539 | (?:(?:un)?signed\s+)?long\s+long\s+int| |
| 540 | (?:(?:un)?signed\s+)?long\s+long| |
| 541 | int\s+long\s+long\s+(?:un)?signed| |
| 542 | int\s+(?:(?:un)?signed\s+)?long\s+long| |
| 543 | |
| 544 | long\s+int\s+(?:un)?signed| |
| 545 | long\s+(?:un)?signed\s+int| |
| 546 | long\s+(?:un)?signed| |
| 547 | (?:(?:un)?signed\s+)?long\s+int| |
| 548 | (?:(?:un)?signed\s+)?long| |
| 549 | int\s+long\s+(?:un)?signed| |
| 550 | int\s+(?:(?:un)?signed\s+)?long| |
| 551 | |
| 552 | int\s+(?:un)?signed| |
| 553 | (?:(?:un)?signed\s+)?int |
| 554 | )}; |
| 555 | |
| 556 | our @typeListFile = (); |
| 557 | our @typeListWithAttr = ( |
| 558 | @typeList, |
| 559 | qr{struct\s+$InitAttribute\s+$Ident}, |
| 560 | qr{union\s+$InitAttribute\s+$Ident}, |
| 561 | ); |
| 562 | |
| 563 | our @modifierList = ( |
| 564 | qr{fastcall}, |
| 565 | ); |
| 566 | our @modifierListFile = (); |
| 567 | |
| 568 | our @mode_permission_funcs = ( |
| 569 | ["module_param", 3], |
| 570 | ["module_param_(?:array|named|string)", 4], |
| 571 | ["module_param_array_named", 5], |
| 572 | ["debugfs_create_(?:file|u8|u16|u32|u64|x8|x16|x32|x64|size_t|atomic_t|bool|blob|regset32|u32_array)", 2], |
| 573 | ["proc_create(?:_data|)", 2], |
| 574 | ["(?:CLASS|DEVICE|SENSOR|SENSOR_DEVICE|IIO_DEVICE)_ATTR", 2], |
| 575 | ["IIO_DEV_ATTR_[A-Z_]+", 1], |
| 576 | ["SENSOR_(?:DEVICE_|)ATTR_2", 2], |
| 577 | ["SENSOR_TEMPLATE(?:_2|)", 3], |
| 578 | ["__ATTR", 2], |
| 579 | ); |
| 580 | |
| 581 | #Create a search pattern for all these functions to speed up a loop below |
| 582 | our $mode_perms_search = ""; |
| 583 | foreach my $entry (@mode_permission_funcs) { |
| 584 | $mode_perms_search .= '|' if ($mode_perms_search ne ""); |
| 585 | $mode_perms_search .= $entry->[0]; |
| 586 | } |
| 587 | $mode_perms_search = "(?:${mode_perms_search})"; |
| 588 | |
| 589 | our %deprecated_apis = ( |
| 590 | "synchronize_rcu_bh" => "synchronize_rcu", |
| 591 | "synchronize_rcu_bh_expedited" => "synchronize_rcu_expedited", |
| 592 | "call_rcu_bh" => "call_rcu", |
| 593 | "rcu_barrier_bh" => "rcu_barrier", |
| 594 | "synchronize_sched" => "synchronize_rcu", |
| 595 | "synchronize_sched_expedited" => "synchronize_rcu_expedited", |
| 596 | "call_rcu_sched" => "call_rcu", |
| 597 | "rcu_barrier_sched" => "rcu_barrier", |
| 598 | "get_state_synchronize_sched" => "get_state_synchronize_rcu", |
| 599 | "cond_synchronize_sched" => "cond_synchronize_rcu", |
| 600 | ); |
| 601 | |
| 602 | #Create a search pattern for all these strings to speed up a loop below |
| 603 | our $deprecated_apis_search = ""; |
| 604 | foreach my $entry (keys %deprecated_apis) { |
| 605 | $deprecated_apis_search .= '|' if ($deprecated_apis_search ne ""); |
| 606 | $deprecated_apis_search .= $entry; |
| 607 | } |
| 608 | $deprecated_apis_search = "(?:${deprecated_apis_search})"; |
| 609 | |
| 610 | our $mode_perms_world_writable = qr{ |
| 611 | S_IWUGO | |
| 612 | S_IWOTH | |
| 613 | S_IRWXUGO | |
| 614 | S_IALLUGO | |
| 615 | 0[0-7][0-7][2367] |
| 616 | }x; |
| 617 | |
| 618 | our %mode_permission_string_types = ( |
| 619 | "S_IRWXU" => 0700, |
| 620 | "S_IRUSR" => 0400, |
| 621 | "S_IWUSR" => 0200, |
| 622 | "S_IXUSR" => 0100, |
| 623 | "S_IRWXG" => 0070, |
| 624 | "S_IRGRP" => 0040, |
| 625 | "S_IWGRP" => 0020, |
| 626 | "S_IXGRP" => 0010, |
| 627 | "S_IRWXO" => 0007, |
| 628 | "S_IROTH" => 0004, |
| 629 | "S_IWOTH" => 0002, |
| 630 | "S_IXOTH" => 0001, |
| 631 | "S_IRWXUGO" => 0777, |
| 632 | "S_IRUGO" => 0444, |
| 633 | "S_IWUGO" => 0222, |
| 634 | "S_IXUGO" => 0111, |
| 635 | ); |
| 636 | |
| 637 | #Create a search pattern for all these strings to speed up a loop below |
| 638 | our $mode_perms_string_search = ""; |
| 639 | foreach my $entry (keys %mode_permission_string_types) { |
| 640 | $mode_perms_string_search .= '|' if ($mode_perms_string_search ne ""); |
| 641 | $mode_perms_string_search .= $entry; |
| 642 | } |
| 643 | our $single_mode_perms_string_search = "(?:${mode_perms_string_search})"; |
| 644 | our $multi_mode_perms_string_search = qr{ |
| 645 | ${single_mode_perms_string_search} |
| 646 | (?:\s*\|\s*${single_mode_perms_string_search})* |
| 647 | }x; |
| 648 | |
| 649 | sub perms_to_octal { |
| 650 | my ($string) = @_; |
| 651 | |
| 652 | return trim($string) if ($string =~ /^\s*0[0-7]{3,3}\s*$/); |
| 653 | |
| 654 | my $val = ""; |
| 655 | my $oval = ""; |
| 656 | my $to = 0; |
| 657 | my $curpos = 0; |
| 658 | my $lastpos = 0; |
| 659 | while ($string =~ /\b(($single_mode_perms_string_search)\b(?:\s*\|\s*)?\s*)/g) { |
| 660 | $curpos = pos($string); |
| 661 | my $match = $2; |
| 662 | my $omatch = $1; |
| 663 | last if ($lastpos > 0 && ($curpos - length($omatch) != $lastpos)); |
| 664 | $lastpos = $curpos; |
| 665 | $to |= $mode_permission_string_types{$match}; |
| 666 | $val .= '\s*\|\s*' if ($val ne ""); |
| 667 | $val .= $match; |
| 668 | $oval .= $omatch; |
| 669 | } |
| 670 | $oval =~ s/^\s*\|\s*//; |
| 671 | $oval =~ s/\s*\|\s*$//; |
| 672 | return sprintf("%04o", $to); |
| 673 | } |
| 674 | |
| 675 | our $allowed_asm_includes = qr{(?x: |
| 676 | irq| |
| 677 | memory| |
| 678 | time| |
| 679 | reboot |
| 680 | )}; |
| 681 | # memory.h: ARM has a custom one |
| 682 | |
| 683 | # Load common spelling mistakes and build regular expression list. |
| 684 | my $misspellings; |
| 685 | my %spelling_fix; |
| 686 | |
| 687 | if (open(my $spelling, '<', $spelling_file)) { |
| 688 | while (<$spelling>) { |
| 689 | my $line = $_; |
| 690 | |
| 691 | $line =~ s/\s*\n?$//g; |
| 692 | $line =~ s/^\s*//g; |
| 693 | |
| 694 | next if ($line =~ m/^\s*#/); |
| 695 | next if ($line =~ m/^\s*$/); |
| 696 | |
| 697 | my ($suspect, $fix) = split(/\|\|/, $line); |
| 698 | |
| 699 | $spelling_fix{$suspect} = $fix; |
| 700 | } |
| 701 | close($spelling); |
| 702 | } else { |
| 703 | warn "No typos will be found - file '$spelling_file': $!\n"; |
| 704 | } |
| 705 | |
| 706 | if ($codespell) { |
| 707 | if (open(my $spelling, '<', $codespellfile)) { |
| 708 | while (<$spelling>) { |
| 709 | my $line = $_; |
| 710 | |
| 711 | $line =~ s/\s*\n?$//g; |
| 712 | $line =~ s/^\s*//g; |
| 713 | |
| 714 | next if ($line =~ m/^\s*#/); |
| 715 | next if ($line =~ m/^\s*$/); |
| 716 | next if ($line =~ m/, disabled/i); |
| 717 | |
| 718 | $line =~ s/,.*$//; |
| 719 | |
| 720 | my ($suspect, $fix) = split(/->/, $line); |
| 721 | |
| 722 | $spelling_fix{$suspect} = $fix; |
| 723 | } |
| 724 | close($spelling); |
| 725 | } else { |
| 726 | warn "No codespell typos will be found - file '$codespellfile': $!\n"; |
| 727 | } |
| 728 | } |
| 729 | |
| 730 | $misspellings = join("|", sort keys %spelling_fix) if keys %spelling_fix; |
| 731 | |
| 732 | sub read_words { |
| 733 | my ($wordsRef, $file) = @_; |
| 734 | |
| 735 | if (open(my $words, '<', $file)) { |
| 736 | while (<$words>) { |
| 737 | my $line = $_; |
| 738 | |
| 739 | $line =~ s/\s*\n?$//g; |
| 740 | $line =~ s/^\s*//g; |
| 741 | |
| 742 | next if ($line =~ m/^\s*#/); |
| 743 | next if ($line =~ m/^\s*$/); |
| 744 | if ($line =~ /\s/) { |
| 745 | print("$file: '$line' invalid - ignored\n"); |
| 746 | next; |
| 747 | } |
| 748 | |
| 749 | $$wordsRef .= '|' if ($$wordsRef ne ""); |
| 750 | $$wordsRef .= $line; |
| 751 | } |
| 752 | close($file); |
| 753 | return 1; |
| 754 | } |
| 755 | |
| 756 | return 0; |
| 757 | } |
| 758 | |
| 759 | my $const_structs = ""; |
| 760 | read_words(\$const_structs, $conststructsfile) |
| 761 | or warn "No structs that should be const will be found - file '$conststructsfile': $!\n"; |
| 762 | |
| 763 | my $typeOtherTypedefs = ""; |
| 764 | if (length($typedefsfile)) { |
| 765 | read_words(\$typeOtherTypedefs, $typedefsfile) |
| 766 | or warn "No additional types will be considered - file '$typedefsfile': $!\n"; |
| 767 | } |
| 768 | $typeTypedefs .= '|' . $typeOtherTypedefs if ($typeOtherTypedefs ne ""); |
| 769 | |
| 770 | sub build_types { |
| 771 | my $mods = "(?x: \n" . join("|\n ", (@modifierList, @modifierListFile)) . "\n)"; |
| 772 | my $all = "(?x: \n" . join("|\n ", (@typeList, @typeListFile)) . "\n)"; |
| 773 | my $Misordered = "(?x: \n" . join("|\n ", @typeListMisordered) . "\n)"; |
| 774 | my $allWithAttr = "(?x: \n" . join("|\n ", @typeListWithAttr) . "\n)"; |
| 775 | $Modifier = qr{(?:$Attribute|$Sparse|$mods)}; |
| 776 | $BasicType = qr{ |
| 777 | (?:$typeTypedefs\b)| |
| 778 | (?:${all}\b) |
| 779 | }x; |
| 780 | $NonptrType = qr{ |
| 781 | (?:$Modifier\s+|const\s+)* |
| 782 | (?: |
| 783 | (?:typeof|__typeof__)\s*\([^\)]*\)| |
| 784 | (?:$typeTypedefs\b)| |
| 785 | (?:${all}\b) |
| 786 | ) |
| 787 | (?:\s+$Modifier|\s+const)* |
| 788 | }x; |
| 789 | $NonptrTypeMisordered = qr{ |
| 790 | (?:$Modifier\s+|const\s+)* |
| 791 | (?: |
| 792 | (?:${Misordered}\b) |
| 793 | ) |
| 794 | (?:\s+$Modifier|\s+const)* |
| 795 | }x; |
| 796 | $NonptrTypeWithAttr = qr{ |
| 797 | (?:$Modifier\s+|const\s+)* |
| 798 | (?: |
| 799 | (?:typeof|__typeof__)\s*\([^\)]*\)| |
| 800 | (?:$typeTypedefs\b)| |
| 801 | (?:${allWithAttr}\b) |
| 802 | ) |
| 803 | (?:\s+$Modifier|\s+const)* |
| 804 | }x; |
| 805 | $Type = qr{ |
| 806 | $NonptrType |
| 807 | (?:(?:\s|\*|\[\])+\s*const|(?:\s|\*\s*(?:const\s*)?|\[\])+|(?:\s*\[\s*\])+)? |
| 808 | (?:\s+$Inline|\s+$Modifier)* |
| 809 | }x; |
| 810 | $TypeMisordered = qr{ |
| 811 | $NonptrTypeMisordered |
| 812 | (?:(?:\s|\*|\[\])+\s*const|(?:\s|\*\s*(?:const\s*)?|\[\])+|(?:\s*\[\s*\])+)? |
| 813 | (?:\s+$Inline|\s+$Modifier)* |
| 814 | }x; |
| 815 | $Declare = qr{(?:$Storage\s+(?:$Inline\s+)?)?$Type}; |
| 816 | $DeclareMisordered = qr{(?:$Storage\s+(?:$Inline\s+)?)?$TypeMisordered}; |
| 817 | } |
| 818 | build_types(); |
| 819 | |
| 820 | our $Typecast = qr{\s*(\(\s*$NonptrType\s*\)){0,1}\s*}; |
| 821 | |
| 822 | # Using $balanced_parens, $LvalOrFunc, or $FuncArg |
| 823 | # requires at least perl version v5.10.0 |
| 824 | # Any use must be runtime checked with $^V |
| 825 | |
| 826 | our $balanced_parens = qr/(\((?:[^\(\)]++|(?-1))*\))/; |
| 827 | our $LvalOrFunc = qr{((?:[\&\*]\s*)?$Lval)\s*($balanced_parens{0,1})\s*}; |
| 828 | our $FuncArg = qr{$Typecast{0,1}($LvalOrFunc|$Constant|$String)}; |
| 829 | |
| 830 | our $declaration_macros = qr{(?x: |
| 831 | (?:$Storage\s+)?(?:[A-Z_][A-Z0-9]*_){0,2}(?:DEFINE|DECLARE)(?:_[A-Z0-9]+){1,6}\s*\(| |
| 832 | (?:$Storage\s+)?[HLP]?LIST_HEAD\s*\(| |
| 833 | (?:$Storage\s+)?${Type}\s+uninitialized_var\s*\(| |
| 834 | (?:SKCIPHER_REQUEST|SHASH_DESC|AHASH_REQUEST)_ON_STACK\s*\( |
| 835 | )}; |
| 836 | |
| 837 | sub deparenthesize { |
| 838 | my ($string) = @_; |
| 839 | return "" if (!defined($string)); |
| 840 | |
| 841 | while ($string =~ /^\s*\(.*\)\s*$/) { |
| 842 | $string =~ s@^\s*\(\s*@@; |
| 843 | $string =~ s@\s*\)\s*$@@; |
| 844 | } |
| 845 | |
| 846 | $string =~ s@\s+@ @g; |
| 847 | |
| 848 | return $string; |
| 849 | } |
| 850 | |
| 851 | sub seed_camelcase_file { |
| 852 | my ($file) = @_; |
| 853 | |
| 854 | return if (!(-f $file)); |
| 855 | |
| 856 | local $/; |
| 857 | |
| 858 | open(my $include_file, '<', "$file") |
| 859 | or warn "$P: Can't read '$file' $!\n"; |
| 860 | my $text = <$include_file>; |
| 861 | close($include_file); |
| 862 | |
| 863 | my @lines = split('\n', $text); |
| 864 | |
| 865 | foreach my $line (@lines) { |
| 866 | next if ($line !~ /(?:[A-Z][a-z]|[a-z][A-Z])/); |
| 867 | if ($line =~ /^[ \t]*(?:#[ \t]*define|typedef\s+$Type)\s+(\w*(?:[A-Z][a-z]|[a-z][A-Z])\w*)/) { |
| 868 | $camelcase{$1} = 1; |
| 869 | } elsif ($line =~ /^\s*$Declare\s+(\w*(?:[A-Z][a-z]|[a-z][A-Z])\w*)\s*[\(\[,;]/) { |
| 870 | $camelcase{$1} = 1; |
| 871 | } elsif ($line =~ /^\s*(?:union|struct|enum)\s+(\w*(?:[A-Z][a-z]|[a-z][A-Z])\w*)\s*[;\{]/) { |
| 872 | $camelcase{$1} = 1; |
| 873 | } |
| 874 | } |
| 875 | } |
| 876 | |
| 877 | sub is_maintained_obsolete { |
| 878 | my ($filename) = @_; |
| 879 | |
| 880 | return 0 if (!$tree || !(-e "$root/scripts/get_maintainer.pl")); |
| 881 | |
| 882 | my $status = `perl $root/scripts/get_maintainer.pl --status --nom --nol --nogit --nogit-fallback -f $filename 2>&1`; |
| 883 | |
| 884 | return $status =~ /obsolete/i; |
| 885 | } |
| 886 | |
| 887 | sub is_SPDX_License_valid { |
| 888 | my ($license) = @_; |
| 889 | |
| 890 | return 1 if (!$tree || which("python") eq "" || !(-e "$root/scripts/spdxcheck.py") || !(-e "$root/.git")); |
| 891 | |
| 892 | my $root_path = abs_path($root); |
| 893 | my $status = `cd "$root_path"; echo "$license" | python scripts/spdxcheck.py -`; |
| 894 | return 0 if ($status ne ""); |
| 895 | return 1; |
| 896 | } |
| 897 | |
| 898 | my $camelcase_seeded = 0; |
| 899 | sub seed_camelcase_includes { |
| 900 | return if ($camelcase_seeded); |
| 901 | |
| 902 | my $files; |
| 903 | my $camelcase_cache = ""; |
| 904 | my @include_files = (); |
| 905 | |
| 906 | $camelcase_seeded = 1; |
| 907 | |
| 908 | if (-e ".git") { |
| 909 | my $git_last_include_commit = `${git_command} log --no-merges --pretty=format:"%h%n" -1 -- include`; |
| 910 | chomp $git_last_include_commit; |
| 911 | $camelcase_cache = ".checkpatch-camelcase.git.$git_last_include_commit"; |
| 912 | } else { |
| 913 | my $last_mod_date = 0; |
| 914 | $files = `find $root/include -name "*.h"`; |
| 915 | @include_files = split('\n', $files); |
| 916 | foreach my $file (@include_files) { |
| 917 | my $date = POSIX::strftime("%Y%m%d%H%M", |
| 918 | localtime((stat $file)[9])); |
| 919 | $last_mod_date = $date if ($last_mod_date < $date); |
| 920 | } |
| 921 | $camelcase_cache = ".checkpatch-camelcase.date.$last_mod_date"; |
| 922 | } |
| 923 | |
| 924 | if ($camelcase_cache ne "" && -f $camelcase_cache) { |
| 925 | open(my $camelcase_file, '<', "$camelcase_cache") |
| 926 | or warn "$P: Can't read '$camelcase_cache' $!\n"; |
| 927 | while (<$camelcase_file>) { |
| 928 | chomp; |
| 929 | $camelcase{$_} = 1; |
| 930 | } |
| 931 | close($camelcase_file); |
| 932 | |
| 933 | return; |
| 934 | } |
| 935 | |
| 936 | if (-e ".git") { |
| 937 | $files = `${git_command} ls-files "include/*.h"`; |
| 938 | @include_files = split('\n', $files); |
| 939 | } |
| 940 | |
| 941 | foreach my $file (@include_files) { |
| 942 | seed_camelcase_file($file); |
| 943 | } |
| 944 | |
| 945 | if ($camelcase_cache ne "") { |
| 946 | unlink glob ".checkpatch-camelcase.*"; |
| 947 | open(my $camelcase_file, '>', "$camelcase_cache") |
| 948 | or warn "$P: Can't write '$camelcase_cache' $!\n"; |
| 949 | foreach (sort { lc($a) cmp lc($b) } keys(%camelcase)) { |
| 950 | print $camelcase_file ("$_\n"); |
| 951 | } |
| 952 | close($camelcase_file); |
| 953 | } |
| 954 | } |
| 955 | |
| 956 | sub git_commit_info { |
| 957 | my ($commit, $id, $desc) = @_; |
| 958 | |
| 959 | return ($id, $desc) if ((which("git") eq "") || !(-e ".git")); |
| 960 | |
| 961 | my $output = `${git_command} log --no-color --format='%H %s' -1 $commit 2>&1`; |
| 962 | $output =~ s/^\s*//gm; |
| 963 | my @lines = split("\n", $output); |
| 964 | |
| 965 | return ($id, $desc) if ($#lines < 0); |
| 966 | |
| 967 | if ($lines[0] =~ /^error: short SHA1 $commit is ambiguous/) { |
| 968 | # Maybe one day convert this block of bash into something that returns |
| 969 | # all matching commit ids, but it's very slow... |
| 970 | # |
| 971 | # echo "checking commits $1..." |
| 972 | # git rev-list --remotes | grep -i "^$1" | |
| 973 | # while read line ; do |
| 974 | # git log --format='%H %s' -1 $line | |
| 975 | # echo "commit $(cut -c 1-12,41-)" |
| 976 | # done |
| 977 | } elsif ($lines[0] =~ /^fatal: ambiguous argument '$commit': unknown revision or path not in the working tree\./) { |
| 978 | $id = undef; |
| 979 | } else { |
| 980 | $id = substr($lines[0], 0, 12); |
| 981 | $desc = substr($lines[0], 41); |
| 982 | } |
| 983 | |
| 984 | return ($id, $desc); |
| 985 | } |
| 986 | |
| 987 | $chk_signoff = 0 if ($file); |
| 988 | |
| 989 | my @rawlines = (); |
| 990 | my @lines = (); |
| 991 | my @fixed = (); |
| 992 | my @fixed_inserted = (); |
| 993 | my @fixed_deleted = (); |
| 994 | my $fixlinenr = -1; |
| 995 | |
| 996 | # If input is git commits, extract all commits from the commit expressions. |
| 997 | # For example, HEAD-3 means we need check 'HEAD, HEAD~1, HEAD~2'. |
| 998 | die "$P: No git repository found\n" if ($git && !-e ".git"); |
| 999 | |
| 1000 | if ($git) { |
| 1001 | my @commits = (); |
| 1002 | foreach my $commit_expr (@ARGV) { |
| 1003 | my $git_range; |
| 1004 | if ($commit_expr =~ m/^(.*)-(\d+)$/) { |
| 1005 | $git_range = "-$2 $1"; |
| 1006 | } elsif ($commit_expr =~ m/\.\./) { |
| 1007 | $git_range = "$commit_expr"; |
| 1008 | } else { |
| 1009 | $git_range = "-1 $commit_expr"; |
| 1010 | } |
| 1011 | my $lines = `${git_command} log --no-color --no-merges --pretty=format:'%H %s' $git_range`; |
| 1012 | foreach my $line (split(/\n/, $lines)) { |
| 1013 | $line =~ /^([0-9a-fA-F]{40,40}) (.*)$/; |
| 1014 | next if (!defined($1) || !defined($2)); |
| 1015 | my $sha1 = $1; |
| 1016 | my $subject = $2; |
| 1017 | unshift(@commits, $sha1); |
| 1018 | $git_commits{$sha1} = $subject; |
| 1019 | } |
| 1020 | } |
| 1021 | die "$P: no git commits after extraction!\n" if (@commits == 0); |
| 1022 | @ARGV = @commits; |
| 1023 | } |
| 1024 | |
| 1025 | my $vname; |
| 1026 | $allow_c99_comments = !defined $ignore_type{"C99_COMMENT_TOLERANCE"}; |
| 1027 | for my $filename (@ARGV) { |
| 1028 | my $FILE; |
| 1029 | if ($git) { |
| 1030 | open($FILE, '-|', "git format-patch -M --stdout -1 $filename") || |
| 1031 | die "$P: $filename: git format-patch failed - $!\n"; |
| 1032 | } elsif ($file) { |
| 1033 | open($FILE, '-|', "diff -u /dev/null $filename") || |
| 1034 | die "$P: $filename: diff failed - $!\n"; |
| 1035 | } elsif ($filename eq '-') { |
| 1036 | open($FILE, '<&STDIN'); |
| 1037 | } else { |
| 1038 | open($FILE, '<', "$filename") || |
| 1039 | die "$P: $filename: open failed - $!\n"; |
| 1040 | } |
| 1041 | if ($filename eq '-') { |
| 1042 | $vname = 'Your patch'; |
| 1043 | } elsif ($git) { |
| 1044 | $vname = "Commit " . substr($filename, 0, 12) . ' ("' . $git_commits{$filename} . '")'; |
| 1045 | } else { |
| 1046 | $vname = $filename; |
| 1047 | } |
| 1048 | while (<$FILE>) { |
| 1049 | chomp; |
| 1050 | push(@rawlines, $_); |
| 1051 | } |
| 1052 | close($FILE); |
| 1053 | |
| 1054 | if ($#ARGV > 0 && $quiet == 0) { |
| 1055 | print '-' x length($vname) . "\n"; |
| 1056 | print "$vname\n"; |
| 1057 | print '-' x length($vname) . "\n"; |
| 1058 | } |
| 1059 | |
| 1060 | if (!process($filename)) { |
| 1061 | $exit = 1; |
| 1062 | } |
| 1063 | @rawlines = (); |
| 1064 | @lines = (); |
| 1065 | @fixed = (); |
| 1066 | @fixed_inserted = (); |
| 1067 | @fixed_deleted = (); |
| 1068 | $fixlinenr = -1; |
| 1069 | @modifierListFile = (); |
| 1070 | @typeListFile = (); |
| 1071 | build_types(); |
| 1072 | } |
| 1073 | |
| 1074 | if (!$quiet) { |
| 1075 | hash_show_words(\%use_type, "Used"); |
| 1076 | hash_show_words(\%ignore_type, "Ignored"); |
| 1077 | |
| 1078 | if (!$perl_version_ok) { |
| 1079 | print << "EOM" |
| 1080 | |
| 1081 | NOTE: perl $^V is not modern enough to detect all possible issues. |
| 1082 | An upgrade to at least perl $minimum_perl_version is suggested. |
| 1083 | EOM |
| 1084 | } |
| 1085 | if ($exit) { |
| 1086 | print << "EOM" |
| 1087 | |
| 1088 | NOTE: If any of the errors are false positives, please report |
| 1089 | them to the maintainer, see CHECKPATCH in MAINTAINERS. |
| 1090 | EOM |
| 1091 | } |
| 1092 | } |
| 1093 | |
| 1094 | exit($exit); |
| 1095 | |
| 1096 | sub top_of_kernel_tree { |
| 1097 | my ($root) = @_; |
| 1098 | |
| 1099 | my @tree_check = ( |
| 1100 | "COPYING", "CREDITS", "Kbuild", "MAINTAINERS", "Makefile", |
| 1101 | "README", "Documentation", "arch", "include", "drivers", |
| 1102 | "fs", "init", "ipc", "kernel", "lib", "scripts", |
| 1103 | ); |
| 1104 | |
| 1105 | foreach my $check (@tree_check) { |
| 1106 | if (! -e $root . '/' . $check) { |
| 1107 | return 0; |
| 1108 | } |
| 1109 | } |
| 1110 | return 1; |
| 1111 | } |
| 1112 | |
| 1113 | sub parse_email { |
| 1114 | my ($formatted_email) = @_; |
| 1115 | |
| 1116 | my $name = ""; |
| 1117 | my $address = ""; |
| 1118 | my $comment = ""; |
| 1119 | |
| 1120 | if ($formatted_email =~ /^(.*)<(\S+\@\S+)>(.*)$/) { |
| 1121 | $name = $1; |
| 1122 | $address = $2; |
| 1123 | $comment = $3 if defined $3; |
| 1124 | } elsif ($formatted_email =~ /^\s*<(\S+\@\S+)>(.*)$/) { |
| 1125 | $address = $1; |
| 1126 | $comment = $2 if defined $2; |
| 1127 | } elsif ($formatted_email =~ /(\S+\@\S+)(.*)$/) { |
| 1128 | $address = $1; |
| 1129 | $comment = $2 if defined $2; |
| 1130 | $formatted_email =~ s/\Q$address\E.*$//; |
| 1131 | $name = $formatted_email; |
| 1132 | $name = trim($name); |
| 1133 | $name =~ s/^\"|\"$//g; |
| 1134 | # If there's a name left after stripping spaces and |
| 1135 | # leading quotes, and the address doesn't have both |
| 1136 | # leading and trailing angle brackets, the address |
| 1137 | # is invalid. ie: |
| 1138 | # "joe smith joe@smith.com" bad |
| 1139 | # "joe smith <joe@smith.com" bad |
| 1140 | if ($name ne "" && $address !~ /^<[^>]+>$/) { |
| 1141 | $name = ""; |
| 1142 | $address = ""; |
| 1143 | $comment = ""; |
| 1144 | } |
| 1145 | } |
| 1146 | |
| 1147 | $name = trim($name); |
| 1148 | $name =~ s/^\"|\"$//g; |
| 1149 | $address = trim($address); |
| 1150 | $address =~ s/^\<|\>$//g; |
| 1151 | |
| 1152 | if ($name =~ /[^\w \-]/i) { ##has "must quote" chars |
| 1153 | $name =~ s/(?<!\\)"/\\"/g; ##escape quotes |
| 1154 | $name = "\"$name\""; |
| 1155 | } |
| 1156 | |
| 1157 | return ($name, $address, $comment); |
| 1158 | } |
| 1159 | |
| 1160 | sub format_email { |
| 1161 | my ($name, $address) = @_; |
| 1162 | |
| 1163 | my $formatted_email; |
| 1164 | |
| 1165 | $name = trim($name); |
| 1166 | $name =~ s/^\"|\"$//g; |
| 1167 | $address = trim($address); |
| 1168 | |
| 1169 | if ($name =~ /[^\w \-]/i) { ##has "must quote" chars |
| 1170 | $name =~ s/(?<!\\)"/\\"/g; ##escape quotes |
| 1171 | $name = "\"$name\""; |
| 1172 | } |
| 1173 | |
| 1174 | if ("$name" eq "") { |
| 1175 | $formatted_email = "$address"; |
| 1176 | } else { |
| 1177 | $formatted_email = "$name <$address>"; |
| 1178 | } |
| 1179 | |
| 1180 | return $formatted_email; |
| 1181 | } |
| 1182 | |
| 1183 | sub which { |
| 1184 | my ($bin) = @_; |
| 1185 | |
| 1186 | foreach my $path (split(/:/, $ENV{PATH})) { |
| 1187 | if (-e "$path/$bin") { |
| 1188 | return "$path/$bin"; |
| 1189 | } |
| 1190 | } |
| 1191 | |
| 1192 | return ""; |
| 1193 | } |
| 1194 | |
| 1195 | sub which_conf { |
| 1196 | my ($conf) = @_; |
| 1197 | |
| 1198 | foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) { |
| 1199 | if (-e "$path/$conf") { |
| 1200 | return "$path/$conf"; |
| 1201 | } |
| 1202 | } |
| 1203 | |
| 1204 | return ""; |
| 1205 | } |
| 1206 | |
| 1207 | sub expand_tabs { |
| 1208 | my ($str) = @_; |
| 1209 | |
| 1210 | my $res = ''; |
| 1211 | my $n = 0; |
| 1212 | for my $c (split(//, $str)) { |
| 1213 | if ($c eq "\t") { |
| 1214 | $res .= ' '; |
| 1215 | $n++; |
| 1216 | for (; ($n % 8) != 0; $n++) { |
| 1217 | $res .= ' '; |
| 1218 | } |
| 1219 | next; |
| 1220 | } |
| 1221 | $res .= $c; |
| 1222 | $n++; |
| 1223 | } |
| 1224 | |
| 1225 | return $res; |
| 1226 | } |
| 1227 | sub copy_spacing { |
| 1228 | (my $res = shift) =~ tr/\t/ /c; |
| 1229 | return $res; |
| 1230 | } |
| 1231 | |
| 1232 | sub line_stats { |
| 1233 | my ($line) = @_; |
| 1234 | |
| 1235 | # Drop the diff line leader and expand tabs |
| 1236 | $line =~ s/^.//; |
| 1237 | $line = expand_tabs($line); |
| 1238 | |
| 1239 | # Pick the indent from the front of the line. |
| 1240 | my ($white) = ($line =~ /^(\s*)/); |
| 1241 | |
| 1242 | return (length($line), length($white)); |
| 1243 | } |
| 1244 | |
| 1245 | my $sanitise_quote = ''; |
| 1246 | |
| 1247 | sub sanitise_line_reset { |
| 1248 | my ($in_comment) = @_; |
| 1249 | |
| 1250 | if ($in_comment) { |
| 1251 | $sanitise_quote = '*/'; |
| 1252 | } else { |
| 1253 | $sanitise_quote = ''; |
| 1254 | } |
| 1255 | } |
| 1256 | sub sanitise_line { |
| 1257 | my ($line) = @_; |
| 1258 | |
| 1259 | my $res = ''; |
| 1260 | my $l = ''; |
| 1261 | |
| 1262 | my $qlen = 0; |
| 1263 | my $off = 0; |
| 1264 | my $c; |
| 1265 | |
| 1266 | # Always copy over the diff marker. |
| 1267 | $res = substr($line, 0, 1); |
| 1268 | |
| 1269 | for ($off = 1; $off < length($line); $off++) { |
| 1270 | $c = substr($line, $off, 1); |
| 1271 | |
| 1272 | # Comments we are whacking completely including the begin |
| 1273 | # and end, all to $;. |
| 1274 | if ($sanitise_quote eq '' && substr($line, $off, 2) eq '/*') { |
| 1275 | $sanitise_quote = '*/'; |
| 1276 | |
| 1277 | substr($res, $off, 2, "$;$;"); |
| 1278 | $off++; |
| 1279 | next; |
| 1280 | } |
| 1281 | if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') { |
| 1282 | $sanitise_quote = ''; |
| 1283 | substr($res, $off, 2, "$;$;"); |
| 1284 | $off++; |
| 1285 | next; |
| 1286 | } |
| 1287 | if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') { |
| 1288 | $sanitise_quote = '//'; |
| 1289 | |
| 1290 | substr($res, $off, 2, $sanitise_quote); |
| 1291 | $off++; |
| 1292 | next; |
| 1293 | } |
| 1294 | |
| 1295 | # A \ in a string means ignore the next character. |
| 1296 | if (($sanitise_quote eq "'" || $sanitise_quote eq '"') && |
| 1297 | $c eq "\\") { |
| 1298 | substr($res, $off, 2, 'XX'); |
| 1299 | $off++; |
| 1300 | next; |
| 1301 | } |
| 1302 | # Regular quotes. |
| 1303 | if ($c eq "'" || $c eq '"') { |
| 1304 | if ($sanitise_quote eq '') { |
| 1305 | $sanitise_quote = $c; |
| 1306 | |
| 1307 | substr($res, $off, 1, $c); |
| 1308 | next; |
| 1309 | } elsif ($sanitise_quote eq $c) { |
| 1310 | $sanitise_quote = ''; |
| 1311 | } |
| 1312 | } |
| 1313 | |
| 1314 | #print "c<$c> SQ<$sanitise_quote>\n"; |
| 1315 | if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") { |
| 1316 | substr($res, $off, 1, $;); |
| 1317 | } elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") { |
| 1318 | substr($res, $off, 1, $;); |
| 1319 | } elsif ($off != 0 && $sanitise_quote && $c ne "\t") { |
| 1320 | substr($res, $off, 1, 'X'); |
| 1321 | } else { |
| 1322 | substr($res, $off, 1, $c); |
| 1323 | } |
| 1324 | } |
| 1325 | |
| 1326 | if ($sanitise_quote eq '//') { |
| 1327 | $sanitise_quote = ''; |
| 1328 | } |
| 1329 | |
| 1330 | # The pathname on a #include may be surrounded by '<' and '>'. |
| 1331 | if ($res =~ /^.\s*\#\s*include\s+\<(.*)\>/) { |
| 1332 | my $clean = 'X' x length($1); |
| 1333 | $res =~ s@\<.*\>@<$clean>@; |
| 1334 | |
| 1335 | # The whole of a #error is a string. |
| 1336 | } elsif ($res =~ /^.\s*\#\s*(?:error|warning)\s+(.*)\b/) { |
| 1337 | my $clean = 'X' x length($1); |
| 1338 | $res =~ s@(\#\s*(?:error|warning)\s+).*@$1$clean@; |
| 1339 | } |
| 1340 | |
| 1341 | if ($allow_c99_comments && $res =~ m@(//.*$)@) { |
| 1342 | my $match = $1; |
| 1343 | $res =~ s/\Q$match\E/"$;" x length($match)/e; |
| 1344 | } |
| 1345 | |
| 1346 | return $res; |
| 1347 | } |
| 1348 | |
| 1349 | sub get_quoted_string { |
| 1350 | my ($line, $rawline) = @_; |
| 1351 | |
| 1352 | return "" if (!defined($line) || !defined($rawline)); |
| 1353 | return "" if ($line !~ m/($String)/g); |
| 1354 | return substr($rawline, $-[0], $+[0] - $-[0]); |
| 1355 | } |
| 1356 | |
| 1357 | sub ctx_statement_block { |
| 1358 | my ($linenr, $remain, $off) = @_; |
| 1359 | my $line = $linenr - 1; |
| 1360 | my $blk = ''; |
| 1361 | my $soff = $off; |
| 1362 | my $coff = $off - 1; |
| 1363 | my $coff_set = 0; |
| 1364 | |
| 1365 | my $loff = 0; |
| 1366 | |
| 1367 | my $type = ''; |
| 1368 | my $level = 0; |
| 1369 | my @stack = (); |
| 1370 | my $p; |
| 1371 | my $c; |
| 1372 | my $len = 0; |
| 1373 | |
| 1374 | my $remainder; |
| 1375 | while (1) { |
| 1376 | @stack = (['', 0]) if ($#stack == -1); |
| 1377 | |
| 1378 | #warn "CSB: blk<$blk> remain<$remain>\n"; |
| 1379 | # If we are about to drop off the end, pull in more |
| 1380 | # context. |
| 1381 | if ($off >= $len) { |
| 1382 | for (; $remain > 0; $line++) { |
| 1383 | last if (!defined $lines[$line]); |
| 1384 | next if ($lines[$line] =~ /^-/); |
| 1385 | $remain--; |
| 1386 | $loff = $len; |
| 1387 | $blk .= $lines[$line] . "\n"; |
| 1388 | $len = length($blk); |
| 1389 | $line++; |
| 1390 | last; |
| 1391 | } |
| 1392 | # Bail if there is no further context. |
| 1393 | #warn "CSB: blk<$blk> off<$off> len<$len>\n"; |
| 1394 | if ($off >= $len) { |
| 1395 | last; |
| 1396 | } |
| 1397 | if ($level == 0 && substr($blk, $off) =~ /^.\s*#\s*define/) { |
| 1398 | $level++; |
| 1399 | $type = '#'; |
| 1400 | } |
| 1401 | } |
| 1402 | $p = $c; |
| 1403 | $c = substr($blk, $off, 1); |
| 1404 | $remainder = substr($blk, $off); |
| 1405 | |
| 1406 | #warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>\n"; |
| 1407 | |
| 1408 | # Handle nested #if/#else. |
| 1409 | if ($remainder =~ /^#\s*(?:ifndef|ifdef|if)\s/) { |
| 1410 | push(@stack, [ $type, $level ]); |
| 1411 | } elsif ($remainder =~ /^#\s*(?:else|elif)\b/) { |
| 1412 | ($type, $level) = @{$stack[$#stack - 1]}; |
| 1413 | } elsif ($remainder =~ /^#\s*endif\b/) { |
| 1414 | ($type, $level) = @{pop(@stack)}; |
| 1415 | } |
| 1416 | |
| 1417 | # Statement ends at the ';' or a close '}' at the |
| 1418 | # outermost level. |
| 1419 | if ($level == 0 && $c eq ';') { |
| 1420 | last; |
| 1421 | } |
| 1422 | |
| 1423 | # An else is really a conditional as long as its not else if |
| 1424 | if ($level == 0 && $coff_set == 0 && |
| 1425 | (!defined($p) || $p =~ /(?:\s|\}|\+)/) && |
| 1426 | $remainder =~ /^(else)(?:\s|{)/ && |
| 1427 | $remainder !~ /^else\s+if\b/) { |
| 1428 | $coff = $off + length($1) - 1; |
| 1429 | $coff_set = 1; |
| 1430 | #warn "CSB: mark coff<$coff> soff<$soff> 1<$1>\n"; |
| 1431 | #warn "[" . substr($blk, $soff, $coff - $soff + 1) . "]\n"; |
| 1432 | } |
| 1433 | |
| 1434 | if (($type eq '' || $type eq '(') && $c eq '(') { |
| 1435 | $level++; |
| 1436 | $type = '('; |
| 1437 | } |
| 1438 | if ($type eq '(' && $c eq ')') { |
| 1439 | $level--; |
| 1440 | $type = ($level != 0)? '(' : ''; |
| 1441 | |
| 1442 | if ($level == 0 && $coff < $soff) { |
| 1443 | $coff = $off; |
| 1444 | $coff_set = 1; |
| 1445 | #warn "CSB: mark coff<$coff>\n"; |
| 1446 | } |
| 1447 | } |
| 1448 | if (($type eq '' || $type eq '{') && $c eq '{') { |
| 1449 | $level++; |
| 1450 | $type = '{'; |
| 1451 | } |
| 1452 | if ($type eq '{' && $c eq '}') { |
| 1453 | $level--; |
| 1454 | $type = ($level != 0)? '{' : ''; |
| 1455 | |
| 1456 | if ($level == 0) { |
| 1457 | if (substr($blk, $off + 1, 1) eq ';') { |
| 1458 | $off++; |
| 1459 | } |
| 1460 | last; |
| 1461 | } |
| 1462 | } |
| 1463 | # Preprocessor commands end at the newline unless escaped. |
| 1464 | if ($type eq '#' && $c eq "\n" && $p ne "\\") { |
| 1465 | $level--; |
| 1466 | $type = ''; |
| 1467 | $off++; |
| 1468 | last; |
| 1469 | } |
| 1470 | $off++; |
| 1471 | } |
| 1472 | # We are truly at the end, so shuffle to the next line. |
| 1473 | if ($off == $len) { |
| 1474 | $loff = $len + 1; |
| 1475 | $line++; |
| 1476 | $remain--; |
| 1477 | } |
| 1478 | |
| 1479 | my $statement = substr($blk, $soff, $off - $soff + 1); |
| 1480 | my $condition = substr($blk, $soff, $coff - $soff + 1); |
| 1481 | |
| 1482 | #warn "STATEMENT<$statement>\n"; |
| 1483 | #warn "CONDITION<$condition>\n"; |
| 1484 | |
| 1485 | #print "coff<$coff> soff<$off> loff<$loff>\n"; |
| 1486 | |
| 1487 | return ($statement, $condition, |
| 1488 | $line, $remain + 1, $off - $loff + 1, $level); |
| 1489 | } |
| 1490 | |
| 1491 | sub statement_lines { |
| 1492 | my ($stmt) = @_; |
| 1493 | |
| 1494 | # Strip the diff line prefixes and rip blank lines at start and end. |
| 1495 | $stmt =~ s/(^|\n)./$1/g; |
| 1496 | $stmt =~ s/^\s*//; |
| 1497 | $stmt =~ s/\s*$//; |
| 1498 | |
| 1499 | my @stmt_lines = ($stmt =~ /\n/g); |
| 1500 | |
| 1501 | return $#stmt_lines + 2; |
| 1502 | } |
| 1503 | |
| 1504 | sub statement_rawlines { |
| 1505 | my ($stmt) = @_; |
| 1506 | |
| 1507 | my @stmt_lines = ($stmt =~ /\n/g); |
| 1508 | |
| 1509 | return $#stmt_lines + 2; |
| 1510 | } |
| 1511 | |
| 1512 | sub statement_block_size { |
| 1513 | my ($stmt) = @_; |
| 1514 | |
| 1515 | $stmt =~ s/(^|\n)./$1/g; |
| 1516 | $stmt =~ s/^\s*{//; |
| 1517 | $stmt =~ s/}\s*$//; |
| 1518 | $stmt =~ s/^\s*//; |
| 1519 | $stmt =~ s/\s*$//; |
| 1520 | |
| 1521 | my @stmt_lines = ($stmt =~ /\n/g); |
| 1522 | my @stmt_statements = ($stmt =~ /;/g); |
| 1523 | |
| 1524 | my $stmt_lines = $#stmt_lines + 2; |
| 1525 | my $stmt_statements = $#stmt_statements + 1; |
| 1526 | |
| 1527 | if ($stmt_lines > $stmt_statements) { |
| 1528 | return $stmt_lines; |
| 1529 | } else { |
| 1530 | return $stmt_statements; |
| 1531 | } |
| 1532 | } |
| 1533 | |
| 1534 | sub ctx_statement_full { |
| 1535 | my ($linenr, $remain, $off) = @_; |
| 1536 | my ($statement, $condition, $level); |
| 1537 | |
| 1538 | my (@chunks); |
| 1539 | |
| 1540 | # Grab the first conditional/block pair. |
| 1541 | ($statement, $condition, $linenr, $remain, $off, $level) = |
| 1542 | ctx_statement_block($linenr, $remain, $off); |
| 1543 | #print "F: c<$condition> s<$statement> remain<$remain>\n"; |
| 1544 | push(@chunks, [ $condition, $statement ]); |
| 1545 | if (!($remain > 0 && $condition =~ /^\s*(?:\n[+-])?\s*(?:if|else|do)\b/s)) { |
| 1546 | return ($level, $linenr, @chunks); |
| 1547 | } |
| 1548 | |
| 1549 | # Pull in the following conditional/block pairs and see if they |
| 1550 | # could continue the statement. |
| 1551 | for (;;) { |
| 1552 | ($statement, $condition, $linenr, $remain, $off, $level) = |
| 1553 | ctx_statement_block($linenr, $remain, $off); |
| 1554 | #print "C: c<$condition> s<$statement> remain<$remain>\n"; |
| 1555 | last if (!($remain > 0 && $condition =~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s)); |
| 1556 | #print "C: push\n"; |
| 1557 | push(@chunks, [ $condition, $statement ]); |
| 1558 | } |
| 1559 | |
| 1560 | return ($level, $linenr, @chunks); |
| 1561 | } |
| 1562 | |
| 1563 | sub ctx_block_get { |
| 1564 | my ($linenr, $remain, $outer, $open, $close, $off) = @_; |
| 1565 | my $line; |
| 1566 | my $start = $linenr - 1; |
| 1567 | my $blk = ''; |
| 1568 | my @o; |
| 1569 | my @c; |
| 1570 | my @res = (); |
| 1571 | |
| 1572 | my $level = 0; |
| 1573 | my @stack = ($level); |
| 1574 | for ($line = $start; $remain > 0; $line++) { |
| 1575 | next if ($rawlines[$line] =~ /^-/); |
| 1576 | $remain--; |
| 1577 | |
| 1578 | $blk .= $rawlines[$line]; |
| 1579 | |
| 1580 | # Handle nested #if/#else. |
| 1581 | if ($lines[$line] =~ /^.\s*#\s*(?:ifndef|ifdef|if)\s/) { |
| 1582 | push(@stack, $level); |
| 1583 | } elsif ($lines[$line] =~ /^.\s*#\s*(?:else|elif)\b/) { |
| 1584 | $level = $stack[$#stack - 1]; |
| 1585 | } elsif ($lines[$line] =~ /^.\s*#\s*endif\b/) { |
| 1586 | $level = pop(@stack); |
| 1587 | } |
| 1588 | |
| 1589 | foreach my $c (split(//, $lines[$line])) { |
| 1590 | ##print "C<$c>L<$level><$open$close>O<$off>\n"; |
| 1591 | if ($off > 0) { |
| 1592 | $off--; |
| 1593 | next; |
| 1594 | } |
| 1595 | |
| 1596 | if ($c eq $close && $level > 0) { |
| 1597 | $level--; |
| 1598 | last if ($level == 0); |
| 1599 | } elsif ($c eq $open) { |
| 1600 | $level++; |
| 1601 | } |
| 1602 | } |
| 1603 | |
| 1604 | if (!$outer || $level <= 1) { |
| 1605 | push(@res, $rawlines[$line]); |
| 1606 | } |
| 1607 | |
| 1608 | last if ($level == 0); |
| 1609 | } |
| 1610 | |
| 1611 | return ($level, @res); |
| 1612 | } |
| 1613 | sub ctx_block_outer { |
| 1614 | my ($linenr, $remain) = @_; |
| 1615 | |
| 1616 | my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0); |
| 1617 | return @r; |
| 1618 | } |
| 1619 | sub ctx_block { |
| 1620 | my ($linenr, $remain) = @_; |
| 1621 | |
| 1622 | my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0); |
| 1623 | return @r; |
| 1624 | } |
| 1625 | sub ctx_statement { |
| 1626 | my ($linenr, $remain, $off) = @_; |
| 1627 | |
| 1628 | my ($level, @r) = ctx_block_get($linenr, $remain, 0, '(', ')', $off); |
| 1629 | return @r; |
| 1630 | } |
| 1631 | sub ctx_block_level { |
| 1632 | my ($linenr, $remain) = @_; |
| 1633 | |
| 1634 | return ctx_block_get($linenr, $remain, 0, '{', '}', 0); |
| 1635 | } |
| 1636 | sub ctx_statement_level { |
| 1637 | my ($linenr, $remain, $off) = @_; |
| 1638 | |
| 1639 | return ctx_block_get($linenr, $remain, 0, '(', ')', $off); |
| 1640 | } |
| 1641 | |
| 1642 | sub ctx_locate_comment { |
| 1643 | my ($first_line, $end_line) = @_; |
| 1644 | |
| 1645 | # Catch a comment on the end of the line itself. |
| 1646 | my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@); |
| 1647 | return $current_comment if (defined $current_comment); |
| 1648 | |
| 1649 | # Look through the context and try and figure out if there is a |
| 1650 | # comment. |
| 1651 | my $in_comment = 0; |
| 1652 | $current_comment = ''; |
| 1653 | for (my $linenr = $first_line; $linenr < $end_line; $linenr++) { |
| 1654 | my $line = $rawlines[$linenr - 1]; |
| 1655 | #warn " $line\n"; |
| 1656 | if ($linenr == $first_line and $line =~ m@^.\s*\*@) { |
| 1657 | $in_comment = 1; |
| 1658 | } |
| 1659 | if ($line =~ m@/\*@) { |
| 1660 | $in_comment = 1; |
| 1661 | } |
| 1662 | if (!$in_comment && $current_comment ne '') { |
| 1663 | $current_comment = ''; |
| 1664 | } |
| 1665 | $current_comment .= $line . "\n" if ($in_comment); |
| 1666 | if ($line =~ m@\*/@) { |
| 1667 | $in_comment = 0; |
| 1668 | } |
| 1669 | } |
| 1670 | |
| 1671 | chomp($current_comment); |
| 1672 | return($current_comment); |
| 1673 | } |
| 1674 | sub ctx_has_comment { |
| 1675 | my ($first_line, $end_line) = @_; |
| 1676 | my $cmt = ctx_locate_comment($first_line, $end_line); |
| 1677 | |
| 1678 | ##print "LINE: $rawlines[$end_line - 1 ]\n"; |
| 1679 | ##print "CMMT: $cmt\n"; |
| 1680 | |
| 1681 | return ($cmt ne ''); |
| 1682 | } |
| 1683 | |
| 1684 | sub raw_line { |
| 1685 | my ($linenr, $cnt) = @_; |
| 1686 | |
| 1687 | my $offset = $linenr - 1; |
| 1688 | $cnt++; |
| 1689 | |
| 1690 | my $line; |
| 1691 | while ($cnt) { |
| 1692 | $line = $rawlines[$offset++]; |
| 1693 | next if (defined($line) && $line =~ /^-/); |
| 1694 | $cnt--; |
| 1695 | } |
| 1696 | |
| 1697 | return $line; |
| 1698 | } |
| 1699 | |
| 1700 | sub get_stat_real { |
| 1701 | my ($linenr, $lc) = @_; |
| 1702 | |
| 1703 | my $stat_real = raw_line($linenr, 0); |
| 1704 | for (my $count = $linenr + 1; $count <= $lc; $count++) { |
| 1705 | $stat_real = $stat_real . "\n" . raw_line($count, 0); |
| 1706 | } |
| 1707 | |
| 1708 | return $stat_real; |
| 1709 | } |
| 1710 | |
| 1711 | sub get_stat_here { |
| 1712 | my ($linenr, $cnt, $here) = @_; |
| 1713 | |
| 1714 | my $herectx = $here . "\n"; |
| 1715 | for (my $n = 0; $n < $cnt; $n++) { |
| 1716 | $herectx .= raw_line($linenr, $n) . "\n"; |
| 1717 | } |
| 1718 | |
| 1719 | return $herectx; |
| 1720 | } |
| 1721 | |
| 1722 | sub cat_vet { |
| 1723 | my ($vet) = @_; |
| 1724 | my ($res, $coded); |
| 1725 | |
| 1726 | $res = ''; |
| 1727 | while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) { |
| 1728 | $res .= $1; |
| 1729 | if ($2 ne '') { |
| 1730 | $coded = sprintf("^%c", unpack('C', $2) + 64); |
| 1731 | $res .= $coded; |
| 1732 | } |
| 1733 | } |
| 1734 | $res =~ s/$/\$/; |
| 1735 | |
| 1736 | return $res; |
| 1737 | } |
| 1738 | |
| 1739 | my $av_preprocessor = 0; |
| 1740 | my $av_pending; |
| 1741 | my @av_paren_type; |
| 1742 | my $av_pend_colon; |
| 1743 | |
| 1744 | sub annotate_reset { |
| 1745 | $av_preprocessor = 0; |
| 1746 | $av_pending = '_'; |
| 1747 | @av_paren_type = ('E'); |
| 1748 | $av_pend_colon = 'O'; |
| 1749 | } |
| 1750 | |
| 1751 | sub annotate_values { |
| 1752 | my ($stream, $type) = @_; |
| 1753 | |
| 1754 | my $res; |
| 1755 | my $var = '_' x length($stream); |
| 1756 | my $cur = $stream; |
| 1757 | |
| 1758 | print "$stream\n" if ($dbg_values > 1); |
| 1759 | |
| 1760 | while (length($cur)) { |
| 1761 | @av_paren_type = ('E') if ($#av_paren_type < 0); |
| 1762 | print " <" . join('', @av_paren_type) . |
| 1763 | "> <$type> <$av_pending>" if ($dbg_values > 1); |
| 1764 | if ($cur =~ /^(\s+)/o) { |
| 1765 | print "WS($1)\n" if ($dbg_values > 1); |
| 1766 | if ($1 =~ /\n/ && $av_preprocessor) { |
| 1767 | $type = pop(@av_paren_type); |
| 1768 | $av_preprocessor = 0; |
| 1769 | } |
| 1770 | |
| 1771 | } elsif ($cur =~ /^(\(\s*$Type\s*)\)/ && $av_pending eq '_') { |
| 1772 | print "CAST($1)\n" if ($dbg_values > 1); |
| 1773 | push(@av_paren_type, $type); |
| 1774 | $type = 'c'; |
| 1775 | |
| 1776 | } elsif ($cur =~ /^($Type)\s*(?:$Ident|,|\)|\(|\s*$)/) { |
| 1777 | print "DECLARE($1)\n" if ($dbg_values > 1); |
| 1778 | $type = 'T'; |
| 1779 | |
| 1780 | } elsif ($cur =~ /^($Modifier)\s*/) { |
| 1781 | print "MODIFIER($1)\n" if ($dbg_values > 1); |
| 1782 | $type = 'T'; |
| 1783 | |
| 1784 | } elsif ($cur =~ /^(\#\s*define\s*$Ident)(\(?)/o) { |
| 1785 | print "DEFINE($1,$2)\n" if ($dbg_values > 1); |
| 1786 | $av_preprocessor = 1; |
| 1787 | push(@av_paren_type, $type); |
| 1788 | if ($2 ne '') { |
| 1789 | $av_pending = 'N'; |
| 1790 | } |
| 1791 | $type = 'E'; |
| 1792 | |
| 1793 | } elsif ($cur =~ /^(\#\s*(?:undef\s*$Ident|include\b))/o) { |
| 1794 | print "UNDEF($1)\n" if ($dbg_values > 1); |
| 1795 | $av_preprocessor = 1; |
| 1796 | push(@av_paren_type, $type); |
| 1797 | |
| 1798 | } elsif ($cur =~ /^(\#\s*(?:ifdef|ifndef|if))/o) { |
| 1799 | print "PRE_START($1)\n" if ($dbg_values > 1); |
| 1800 | $av_preprocessor = 1; |
| 1801 | |
| 1802 | push(@av_paren_type, $type); |
| 1803 | push(@av_paren_type, $type); |
| 1804 | $type = 'E'; |
| 1805 | |
| 1806 | } elsif ($cur =~ /^(\#\s*(?:else|elif))/o) { |
| 1807 | print "PRE_RESTART($1)\n" if ($dbg_values > 1); |
| 1808 | $av_preprocessor = 1; |
| 1809 | |
| 1810 | push(@av_paren_type, $av_paren_type[$#av_paren_type]); |
| 1811 | |
| 1812 | $type = 'E'; |
| 1813 | |
| 1814 | } elsif ($cur =~ /^(\#\s*(?:endif))/o) { |
| 1815 | print "PRE_END($1)\n" if ($dbg_values > 1); |
| 1816 | |
| 1817 | $av_preprocessor = 1; |
| 1818 | |
| 1819 | # Assume all arms of the conditional end as this |
| 1820 | # one does, and continue as if the #endif was not here. |
| 1821 | pop(@av_paren_type); |
| 1822 | push(@av_paren_type, $type); |
| 1823 | $type = 'E'; |
| 1824 | |
| 1825 | } elsif ($cur =~ /^(\\\n)/o) { |
| 1826 | print "PRECONT($1)\n" if ($dbg_values > 1); |
| 1827 | |
| 1828 | } elsif ($cur =~ /^(__attribute__)\s*\(?/o) { |
| 1829 | print "ATTR($1)\n" if ($dbg_values > 1); |
| 1830 | $av_pending = $type; |
| 1831 | $type = 'N'; |
| 1832 | |
| 1833 | } elsif ($cur =~ /^(sizeof)\s*(\()?/o) { |
| 1834 | print "SIZEOF($1)\n" if ($dbg_values > 1); |
| 1835 | if (defined $2) { |
| 1836 | $av_pending = 'V'; |
| 1837 | } |
| 1838 | $type = 'N'; |
| 1839 | |
| 1840 | } elsif ($cur =~ /^(if|while|for)\b/o) { |
| 1841 | print "COND($1)\n" if ($dbg_values > 1); |
| 1842 | $av_pending = 'E'; |
| 1843 | $type = 'N'; |
| 1844 | |
| 1845 | } elsif ($cur =~/^(case)/o) { |
| 1846 | print "CASE($1)\n" if ($dbg_values > 1); |
| 1847 | $av_pend_colon = 'C'; |
| 1848 | $type = 'N'; |
| 1849 | |
| 1850 | } elsif ($cur =~/^(return|else|goto|typeof|__typeof__)\b/o) { |
| 1851 | print "KEYWORD($1)\n" if ($dbg_values > 1); |
| 1852 | $type = 'N'; |
| 1853 | |
| 1854 | } elsif ($cur =~ /^(\()/o) { |
| 1855 | print "PAREN('$1')\n" if ($dbg_values > 1); |
| 1856 | push(@av_paren_type, $av_pending); |
| 1857 | $av_pending = '_'; |
| 1858 | $type = 'N'; |
| 1859 | |
| 1860 | } elsif ($cur =~ /^(\))/o) { |
| 1861 | my $new_type = pop(@av_paren_type); |
| 1862 | if ($new_type ne '_') { |
| 1863 | $type = $new_type; |
| 1864 | print "PAREN('$1') -> $type\n" |
| 1865 | if ($dbg_values > 1); |
| 1866 | } else { |
| 1867 | print "PAREN('$1')\n" if ($dbg_values > 1); |
| 1868 | } |
| 1869 | |
| 1870 | } elsif ($cur =~ /^($Ident)\s*\(/o) { |
| 1871 | print "FUNC($1)\n" if ($dbg_values > 1); |
| 1872 | $type = 'V'; |
| 1873 | $av_pending = 'V'; |
| 1874 | |
| 1875 | } elsif ($cur =~ /^($Ident\s*):(?:\s*\d+\s*(,|=|;))?/) { |
| 1876 | if (defined $2 && $type eq 'C' || $type eq 'T') { |
| 1877 | $av_pend_colon = 'B'; |
| 1878 | } elsif ($type eq 'E') { |
| 1879 | $av_pend_colon = 'L'; |
| 1880 | } |
| 1881 | print "IDENT_COLON($1,$type>$av_pend_colon)\n" if ($dbg_values > 1); |
| 1882 | $type = 'V'; |
| 1883 | |
| 1884 | } elsif ($cur =~ /^($Ident|$Constant)/o) { |
| 1885 | print "IDENT($1)\n" if ($dbg_values > 1); |
| 1886 | $type = 'V'; |
| 1887 | |
| 1888 | } elsif ($cur =~ /^($Assignment)/o) { |
| 1889 | print "ASSIGN($1)\n" if ($dbg_values > 1); |
| 1890 | $type = 'N'; |
| 1891 | |
| 1892 | } elsif ($cur =~/^(;|{|})/) { |
| 1893 | print "END($1)\n" if ($dbg_values > 1); |
| 1894 | $type = 'E'; |
| 1895 | $av_pend_colon = 'O'; |
| 1896 | |
| 1897 | } elsif ($cur =~/^(,)/) { |
| 1898 | print "COMMA($1)\n" if ($dbg_values > 1); |
| 1899 | $type = 'C'; |
| 1900 | |
| 1901 | } elsif ($cur =~ /^(\?)/o) { |
| 1902 | print "QUESTION($1)\n" if ($dbg_values > 1); |
| 1903 | $type = 'N'; |
| 1904 | |
| 1905 | } elsif ($cur =~ /^(:)/o) { |
| 1906 | print "COLON($1,$av_pend_colon)\n" if ($dbg_values > 1); |
| 1907 | |
| 1908 | substr($var, length($res), 1, $av_pend_colon); |
| 1909 | if ($av_pend_colon eq 'C' || $av_pend_colon eq 'L') { |
| 1910 | $type = 'E'; |
| 1911 | } else { |
| 1912 | $type = 'N'; |
| 1913 | } |
| 1914 | $av_pend_colon = 'O'; |
| 1915 | |
| 1916 | } elsif ($cur =~ /^(\[)/o) { |
| 1917 | print "CLOSE($1)\n" if ($dbg_values > 1); |
| 1918 | $type = 'N'; |
| 1919 | |
| 1920 | } elsif ($cur =~ /^(-(?![->])|\+(?!\+)|\*|\&\&|\&)/o) { |
| 1921 | my $variant; |
| 1922 | |
| 1923 | print "OPV($1)\n" if ($dbg_values > 1); |
| 1924 | if ($type eq 'V') { |
| 1925 | $variant = 'B'; |
| 1926 | } else { |
| 1927 | $variant = 'U'; |
| 1928 | } |
| 1929 | |
| 1930 | substr($var, length($res), 1, $variant); |
| 1931 | $type = 'N'; |
| 1932 | |
| 1933 | } elsif ($cur =~ /^($Operators)/o) { |
| 1934 | print "OP($1)\n" if ($dbg_values > 1); |
| 1935 | if ($1 ne '++' && $1 ne '--') { |
| 1936 | $type = 'N'; |
| 1937 | } |
| 1938 | |
| 1939 | } elsif ($cur =~ /(^.)/o) { |
| 1940 | print "C($1)\n" if ($dbg_values > 1); |
| 1941 | } |
| 1942 | if (defined $1) { |
| 1943 | $cur = substr($cur, length($1)); |
| 1944 | $res .= $type x length($1); |
| 1945 | } |
| 1946 | } |
| 1947 | |
| 1948 | return ($res, $var); |
| 1949 | } |
| 1950 | |
| 1951 | sub possible { |
| 1952 | my ($possible, $line) = @_; |
| 1953 | my $notPermitted = qr{(?: |
| 1954 | ^(?: |
| 1955 | $Modifier| |
| 1956 | $Storage| |
| 1957 | $Type| |
| 1958 | DEFINE_\S+ |
| 1959 | )$| |
| 1960 | ^(?: |
| 1961 | goto| |
| 1962 | return| |
| 1963 | case| |
| 1964 | else| |
| 1965 | asm|__asm__| |
| 1966 | do| |
| 1967 | \#| |
| 1968 | \#\#| |
| 1969 | )(?:\s|$)| |
| 1970 | ^(?:typedef|struct|enum)\b |
| 1971 | )}x; |
| 1972 | warn "CHECK<$possible> ($line)\n" if ($dbg_possible > 2); |
| 1973 | if ($possible !~ $notPermitted) { |
| 1974 | # Check for modifiers. |
| 1975 | $possible =~ s/\s*$Storage\s*//g; |
| 1976 | $possible =~ s/\s*$Sparse\s*//g; |
| 1977 | if ($possible =~ /^\s*$/) { |
| 1978 | |
| 1979 | } elsif ($possible =~ /\s/) { |
| 1980 | $possible =~ s/\s*$Type\s*//g; |
| 1981 | for my $modifier (split(' ', $possible)) { |
| 1982 | if ($modifier !~ $notPermitted) { |
| 1983 | warn "MODIFIER: $modifier ($possible) ($line)\n" if ($dbg_possible); |
| 1984 | push(@modifierListFile, $modifier); |
| 1985 | } |
| 1986 | } |
| 1987 | |
| 1988 | } else { |
| 1989 | warn "POSSIBLE: $possible ($line)\n" if ($dbg_possible); |
| 1990 | push(@typeListFile, $possible); |
| 1991 | } |
| 1992 | build_types(); |
| 1993 | } else { |
| 1994 | warn "NOTPOSS: $possible ($line)\n" if ($dbg_possible > 1); |
| 1995 | } |
| 1996 | } |
| 1997 | |
| 1998 | my $prefix = ''; |
| 1999 | |
| 2000 | sub show_type { |
| 2001 | my ($type) = @_; |
| 2002 | |
| 2003 | $type =~ tr/[a-z]/[A-Z]/; |
| 2004 | |
| 2005 | return defined $use_type{$type} if (scalar keys %use_type > 0); |
| 2006 | |
| 2007 | return !defined $ignore_type{$type}; |
| 2008 | } |
| 2009 | |
| 2010 | sub report { |
| 2011 | my ($level, $type, $msg) = @_; |
| 2012 | |
| 2013 | if (!show_type($type) || |
| 2014 | (defined $tst_only && $msg !~ /\Q$tst_only\E/)) { |
| 2015 | return 0; |
| 2016 | } |
| 2017 | my $output = ''; |
| 2018 | if ($color) { |
| 2019 | if ($level eq 'ERROR') { |
| 2020 | $output .= RED; |
| 2021 | } elsif ($level eq 'WARNING') { |
| 2022 | $output .= YELLOW; |
| 2023 | } else { |
| 2024 | $output .= GREEN; |
| 2025 | } |
| 2026 | } |
| 2027 | $output .= $prefix . $level . ':'; |
| 2028 | if ($show_types) { |
| 2029 | $output .= BLUE if ($color); |
| 2030 | $output .= "$type:"; |
| 2031 | } |
| 2032 | $output .= RESET if ($color); |
| 2033 | $output .= ' ' . $msg . "\n"; |
| 2034 | |
| 2035 | if ($showfile) { |
| 2036 | my @lines = split("\n", $output, -1); |
| 2037 | splice(@lines, 1, 1); |
| 2038 | $output = join("\n", @lines); |
| 2039 | } |
| 2040 | $output = (split('\n', $output))[0] . "\n" if ($terse); |
| 2041 | |
| 2042 | push(our @report, $output); |
| 2043 | |
| 2044 | return 1; |
| 2045 | } |
| 2046 | |
| 2047 | sub report_dump { |
| 2048 | our @report; |
| 2049 | } |
| 2050 | |
| 2051 | sub fixup_current_range { |
| 2052 | my ($lineRef, $offset, $length) = @_; |
| 2053 | |
| 2054 | if ($$lineRef =~ /^\@\@ -\d+,\d+ \+(\d+),(\d+) \@\@/) { |
| 2055 | my $o = $1; |
| 2056 | my $l = $2; |
| 2057 | my $no = $o + $offset; |
| 2058 | my $nl = $l + $length; |
| 2059 | $$lineRef =~ s/\+$o,$l \@\@/\+$no,$nl \@\@/; |
| 2060 | } |
| 2061 | } |
| 2062 | |
| 2063 | sub fix_inserted_deleted_lines { |
| 2064 | my ($linesRef, $insertedRef, $deletedRef) = @_; |
| 2065 | |
| 2066 | my $range_last_linenr = 0; |
| 2067 | my $delta_offset = 0; |
| 2068 | |
| 2069 | my $old_linenr = 0; |
| 2070 | my $new_linenr = 0; |
| 2071 | |
| 2072 | my $next_insert = 0; |
| 2073 | my $next_delete = 0; |
| 2074 | |
| 2075 | my @lines = (); |
| 2076 | |
| 2077 | my $inserted = @{$insertedRef}[$next_insert++]; |
| 2078 | my $deleted = @{$deletedRef}[$next_delete++]; |
| 2079 | |
| 2080 | foreach my $old_line (@{$linesRef}) { |
| 2081 | my $save_line = 1; |
| 2082 | my $line = $old_line; #don't modify the array |
| 2083 | if ($line =~ /^(?:\+\+\+|\-\-\-)\s+\S+/) { #new filename |
| 2084 | $delta_offset = 0; |
| 2085 | } elsif ($line =~ /^\@\@ -\d+,\d+ \+\d+,\d+ \@\@/) { #new hunk |
| 2086 | $range_last_linenr = $new_linenr; |
| 2087 | fixup_current_range(\$line, $delta_offset, 0); |
| 2088 | } |
| 2089 | |
| 2090 | while (defined($deleted) && ${$deleted}{'LINENR'} == $old_linenr) { |
| 2091 | $deleted = @{$deletedRef}[$next_delete++]; |
| 2092 | $save_line = 0; |
| 2093 | fixup_current_range(\$lines[$range_last_linenr], $delta_offset--, -1); |
| 2094 | } |
| 2095 | |
| 2096 | while (defined($inserted) && ${$inserted}{'LINENR'} == $old_linenr) { |
| 2097 | push(@lines, ${$inserted}{'LINE'}); |
| 2098 | $inserted = @{$insertedRef}[$next_insert++]; |
| 2099 | $new_linenr++; |
| 2100 | fixup_current_range(\$lines[$range_last_linenr], $delta_offset++, 1); |
| 2101 | } |
| 2102 | |
| 2103 | if ($save_line) { |
| 2104 | push(@lines, $line); |
| 2105 | $new_linenr++; |
| 2106 | } |
| 2107 | |
| 2108 | $old_linenr++; |
| 2109 | } |
| 2110 | |
| 2111 | return @lines; |
| 2112 | } |
| 2113 | |
| 2114 | sub fix_insert_line { |
| 2115 | my ($linenr, $line) = @_; |
| 2116 | |
| 2117 | my $inserted = { |
| 2118 | LINENR => $linenr, |
| 2119 | LINE => $line, |
| 2120 | }; |
| 2121 | push(@fixed_inserted, $inserted); |
| 2122 | } |
| 2123 | |
| 2124 | sub fix_delete_line { |
| 2125 | my ($linenr, $line) = @_; |
| 2126 | |
| 2127 | my $deleted = { |
| 2128 | LINENR => $linenr, |
| 2129 | LINE => $line, |
| 2130 | }; |
| 2131 | |
| 2132 | push(@fixed_deleted, $deleted); |
| 2133 | } |
| 2134 | |
| 2135 | sub ERROR { |
| 2136 | my ($type, $msg) = @_; |
| 2137 | |
| 2138 | if (report("ERROR", $type, $msg)) { |
| 2139 | our $clean = 0; |
| 2140 | our $cnt_error++; |
| 2141 | return 1; |
| 2142 | } |
| 2143 | return 0; |
| 2144 | } |
| 2145 | sub WARN { |
| 2146 | my ($type, $msg) = @_; |
| 2147 | |
| 2148 | if (report("WARNING", $type, $msg)) { |
| 2149 | our $clean = 0; |
| 2150 | our $cnt_warn++; |
| 2151 | return 1; |
| 2152 | } |
| 2153 | return 0; |
| 2154 | } |
| 2155 | sub CHK { |
| 2156 | my ($type, $msg) = @_; |
| 2157 | |
| 2158 | if ($check && report("CHECK", $type, $msg)) { |
| 2159 | our $clean = 0; |
| 2160 | our $cnt_chk++; |
| 2161 | return 1; |
| 2162 | } |
| 2163 | return 0; |
| 2164 | } |
| 2165 | |
| 2166 | sub check_absolute_file { |
| 2167 | my ($absolute, $herecurr) = @_; |
| 2168 | my $file = $absolute; |
| 2169 | |
| 2170 | ##print "absolute<$absolute>\n"; |
| 2171 | |
| 2172 | # See if any suffix of this path is a path within the tree. |
| 2173 | while ($file =~ s@^[^/]*/@@) { |
| 2174 | if (-f "$root/$file") { |
| 2175 | ##print "file<$file>\n"; |
| 2176 | last; |
| 2177 | } |
| 2178 | } |
| 2179 | if (! -f _) { |
| 2180 | return 0; |
| 2181 | } |
| 2182 | |
| 2183 | # It is, so see if the prefix is acceptable. |
| 2184 | my $prefix = $absolute; |
| 2185 | substr($prefix, -length($file)) = ''; |
| 2186 | |
| 2187 | ##print "prefix<$prefix>\n"; |
| 2188 | if ($prefix ne ".../") { |
| 2189 | WARN("USE_RELATIVE_PATH", |
| 2190 | "use relative pathname instead of absolute in changelog text\n" . $herecurr); |
| 2191 | } |
| 2192 | } |
| 2193 | |
| 2194 | sub trim { |
| 2195 | my ($string) = @_; |
| 2196 | |
| 2197 | $string =~ s/^\s+|\s+$//g; |
| 2198 | |
| 2199 | return $string; |
| 2200 | } |
| 2201 | |
| 2202 | sub ltrim { |
| 2203 | my ($string) = @_; |
| 2204 | |
| 2205 | $string =~ s/^\s+//; |
| 2206 | |
| 2207 | return $string; |
| 2208 | } |
| 2209 | |
| 2210 | sub rtrim { |
| 2211 | my ($string) = @_; |
| 2212 | |
| 2213 | $string =~ s/\s+$//; |
| 2214 | |
| 2215 | return $string; |
| 2216 | } |
| 2217 | |
| 2218 | sub string_find_replace { |
| 2219 | my ($string, $find, $replace) = @_; |
| 2220 | |
| 2221 | $string =~ s/$find/$replace/g; |
| 2222 | |
| 2223 | return $string; |
| 2224 | } |
| 2225 | |
| 2226 | sub tabify { |
| 2227 | my ($leading) = @_; |
| 2228 | |
| 2229 | my $source_indent = 8; |
| 2230 | my $max_spaces_before_tab = $source_indent - 1; |
| 2231 | my $spaces_to_tab = " " x $source_indent; |
| 2232 | |
| 2233 | #convert leading spaces to tabs |
| 2234 | 1 while $leading =~ s@^([\t]*)$spaces_to_tab@$1\t@g; |
| 2235 | #Remove spaces before a tab |
| 2236 | 1 while $leading =~ s@^([\t]*)( {1,$max_spaces_before_tab})\t@$1\t@g; |
| 2237 | |
| 2238 | return "$leading"; |
| 2239 | } |
| 2240 | |
| 2241 | sub pos_last_openparen { |
| 2242 | my ($line) = @_; |
| 2243 | |
| 2244 | my $pos = 0; |
| 2245 | |
| 2246 | my $opens = $line =~ tr/\(/\(/; |
| 2247 | my $closes = $line =~ tr/\)/\)/; |
| 2248 | |
| 2249 | my $last_openparen = 0; |
| 2250 | |
| 2251 | if (($opens == 0) || ($closes >= $opens)) { |
| 2252 | return -1; |
| 2253 | } |
| 2254 | |
| 2255 | my $len = length($line); |
| 2256 | |
| 2257 | for ($pos = 0; $pos < $len; $pos++) { |
| 2258 | my $string = substr($line, $pos); |
| 2259 | if ($string =~ /^($FuncArg|$balanced_parens)/) { |
| 2260 | $pos += length($1) - 1; |
| 2261 | } elsif (substr($line, $pos, 1) eq '(') { |
| 2262 | $last_openparen = $pos; |
| 2263 | } elsif (index($string, '(') == -1) { |
| 2264 | last; |
| 2265 | } |
| 2266 | } |
| 2267 | |
| 2268 | return length(expand_tabs(substr($line, 0, $last_openparen))) + 1; |
| 2269 | } |
| 2270 | |
| 2271 | sub process { |
| 2272 | my $filename = shift; |
| 2273 | |
| 2274 | my $linenr=0; |
| 2275 | my $prevline=""; |
| 2276 | my $prevrawline=""; |
| 2277 | my $stashline=""; |
| 2278 | my $stashrawline=""; |
| 2279 | |
| 2280 | my $length; |
| 2281 | my $indent; |
| 2282 | my $previndent=0; |
| 2283 | my $stashindent=0; |
| 2284 | |
| 2285 | our $clean = 1; |
| 2286 | my $signoff = 0; |
| 2287 | my $author = ''; |
| 2288 | my $authorsignoff = 0; |
| 2289 | my $is_patch = 0; |
| 2290 | my $is_binding_patch = -1; |
| 2291 | my $in_header_lines = $file ? 0 : 1; |
| 2292 | my $in_commit_log = 0; #Scanning lines before patch |
| 2293 | my $has_commit_log = 0; #Encountered lines before patch |
| 2294 | my $commit_log_lines = 0; #Number of commit log lines |
| 2295 | my $commit_log_possible_stack_dump = 0; |
| 2296 | my $commit_log_long_line = 0; |
| 2297 | my $commit_log_has_diff = 0; |
| 2298 | my $reported_maintainer_file = 0; |
| 2299 | my $non_utf8_charset = 0; |
| 2300 | |
| 2301 | my $last_blank_line = 0; |
| 2302 | my $last_coalesced_string_linenr = -1; |
| 2303 | |
| 2304 | our @report = (); |
| 2305 | our $cnt_lines = 0; |
| 2306 | our $cnt_error = 0; |
| 2307 | our $cnt_warn = 0; |
| 2308 | our $cnt_chk = 0; |
| 2309 | |
| 2310 | # Trace the real file/line as we go. |
| 2311 | my $realfile = ''; |
| 2312 | my $realline = 0; |
| 2313 | my $realcnt = 0; |
| 2314 | my $here = ''; |
| 2315 | my $context_function; #undef'd unless there's a known function |
| 2316 | my $in_comment = 0; |
| 2317 | my $comment_edge = 0; |
| 2318 | my $first_line = 0; |
| 2319 | my $p1_prefix = ''; |
| 2320 | |
| 2321 | my $prev_values = 'E'; |
| 2322 | |
| 2323 | # suppression flags |
| 2324 | my %suppress_ifbraces; |
| 2325 | my %suppress_whiletrailers; |
| 2326 | my %suppress_export; |
| 2327 | my $suppress_statement = 0; |
| 2328 | |
| 2329 | my %signatures = (); |
| 2330 | |
| 2331 | # Pre-scan the patch sanitizing the lines. |
| 2332 | # Pre-scan the patch looking for any __setup documentation. |
| 2333 | # |
| 2334 | my @setup_docs = (); |
| 2335 | my $setup_docs = 0; |
| 2336 | |
| 2337 | my $camelcase_file_seeded = 0; |
| 2338 | |
| 2339 | my $checklicenseline = 1; |
| 2340 | |
| 2341 | sanitise_line_reset(); |
| 2342 | my $line; |
| 2343 | foreach my $rawline (@rawlines) { |
| 2344 | $linenr++; |
| 2345 | $line = $rawline; |
| 2346 | |
| 2347 | push(@fixed, $rawline) if ($fix); |
| 2348 | |
| 2349 | if ($rawline=~/^\+\+\+\s+(\S+)/) { |
| 2350 | $setup_docs = 0; |
| 2351 | if ($1 =~ m@Documentation/admin-guide/kernel-parameters.rst$@) { |
| 2352 | $setup_docs = 1; |
| 2353 | } |
| 2354 | #next; |
| 2355 | } |
| 2356 | if ($rawline =~ /^\@\@ -\d+(?:,\d+)? \+(\d+)(,(\d+))? \@\@/) { |
| 2357 | $realline=$1-1; |
| 2358 | if (defined $2) { |
| 2359 | $realcnt=$3+1; |
| 2360 | } else { |
| 2361 | $realcnt=1+1; |
| 2362 | } |
| 2363 | $in_comment = 0; |
| 2364 | |
| 2365 | # Guestimate if this is a continuing comment. Run |
| 2366 | # the context looking for a comment "edge". If this |
| 2367 | # edge is a close comment then we must be in a comment |
| 2368 | # at context start. |
| 2369 | my $edge; |
| 2370 | my $cnt = $realcnt; |
| 2371 | for (my $ln = $linenr + 1; $cnt > 0; $ln++) { |
| 2372 | next if (defined $rawlines[$ln - 1] && |
| 2373 | $rawlines[$ln - 1] =~ /^-/); |
| 2374 | $cnt--; |
| 2375 | #print "RAW<$rawlines[$ln - 1]>\n"; |
| 2376 | last if (!defined $rawlines[$ln - 1]); |
| 2377 | if ($rawlines[$ln - 1] =~ m@(/\*|\*/)@ && |
| 2378 | $rawlines[$ln - 1] !~ m@"[^"]*(?:/\*|\*/)[^"]*"@) { |
| 2379 | ($edge) = $1; |
| 2380 | last; |
| 2381 | } |
| 2382 | } |
| 2383 | if (defined $edge && $edge eq '*/') { |
| 2384 | $in_comment = 1; |
| 2385 | } |
| 2386 | |
| 2387 | # Guestimate if this is a continuing comment. If this |
| 2388 | # is the start of a diff block and this line starts |
| 2389 | # ' *' then it is very likely a comment. |
| 2390 | if (!defined $edge && |
| 2391 | $rawlines[$linenr] =~ m@^.\s*(?:\*\*+| \*)(?:\s|$)@) |
| 2392 | { |
| 2393 | $in_comment = 1; |
| 2394 | } |
| 2395 | |
| 2396 | ##print "COMMENT:$in_comment edge<$edge> $rawline\n"; |
| 2397 | sanitise_line_reset($in_comment); |
| 2398 | |
| 2399 | } elsif ($realcnt && $rawline =~ /^(?:\+| |$)/) { |
| 2400 | # Standardise the strings and chars within the input to |
| 2401 | # simplify matching -- only bother with positive lines. |
| 2402 | $line = sanitise_line($rawline); |
| 2403 | } |
| 2404 | push(@lines, $line); |
| 2405 | |
| 2406 | if ($realcnt > 1) { |
| 2407 | $realcnt-- if ($line =~ /^(?:\+| |$)/); |
| 2408 | } else { |
| 2409 | $realcnt = 0; |
| 2410 | } |
| 2411 | |
| 2412 | #print "==>$rawline\n"; |
| 2413 | #print "-->$line\n"; |
| 2414 | |
| 2415 | if ($setup_docs && $line =~ /^\+/) { |
| 2416 | push(@setup_docs, $line); |
| 2417 | } |
| 2418 | } |
| 2419 | |
| 2420 | $prefix = ''; |
| 2421 | |
| 2422 | $realcnt = 0; |
| 2423 | $linenr = 0; |
| 2424 | $fixlinenr = -1; |
| 2425 | foreach my $line (@lines) { |
| 2426 | $linenr++; |
| 2427 | $fixlinenr++; |
| 2428 | my $sline = $line; #copy of $line |
| 2429 | $sline =~ s/$;/ /g; #with comments as spaces |
| 2430 | |
| 2431 | my $rawline = $rawlines[$linenr - 1]; |
| 2432 | |
| 2433 | # check if it's a mode change, rename or start of a patch |
| 2434 | if (!$in_commit_log && |
| 2435 | ($line =~ /^ mode change [0-7]+ => [0-7]+ \S+\s*$/ || |
| 2436 | ($line =~ /^rename (?:from|to) \S+\s*$/ || |
| 2437 | $line =~ /^diff --git a\/[\w\/\.\_\-]+ b\/\S+\s*$/))) { |
| 2438 | $is_patch = 1; |
| 2439 | } |
| 2440 | |
| 2441 | #extract the line range in the file after the patch is applied |
| 2442 | if (!$in_commit_log && |
| 2443 | $line =~ /^\@\@ -\d+(?:,\d+)? \+(\d+)(,(\d+))? \@\@(.*)/) { |
| 2444 | my $context = $4; |
| 2445 | $is_patch = 1; |
| 2446 | $first_line = $linenr + 1; |
| 2447 | $realline=$1-1; |
| 2448 | if (defined $2) { |
| 2449 | $realcnt=$3+1; |
| 2450 | } else { |
| 2451 | $realcnt=1+1; |
| 2452 | } |
| 2453 | annotate_reset(); |
| 2454 | $prev_values = 'E'; |
| 2455 | |
| 2456 | %suppress_ifbraces = (); |
| 2457 | %suppress_whiletrailers = (); |
| 2458 | %suppress_export = (); |
| 2459 | $suppress_statement = 0; |
| 2460 | if ($context =~ /\b(\w+)\s*\(/) { |
| 2461 | $context_function = $1; |
| 2462 | } else { |
| 2463 | undef $context_function; |
| 2464 | } |
| 2465 | next; |
| 2466 | |
| 2467 | # track the line number as we move through the hunk, note that |
| 2468 | # new versions of GNU diff omit the leading space on completely |
| 2469 | # blank context lines so we need to count that too. |
| 2470 | } elsif ($line =~ /^( |\+|$)/) { |
| 2471 | $realline++; |
| 2472 | $realcnt-- if ($realcnt != 0); |
| 2473 | |
| 2474 | # Measure the line length and indent. |
| 2475 | ($length, $indent) = line_stats($rawline); |
| 2476 | |
| 2477 | # Track the previous line. |
| 2478 | ($prevline, $stashline) = ($stashline, $line); |
| 2479 | ($previndent, $stashindent) = ($stashindent, $indent); |
| 2480 | ($prevrawline, $stashrawline) = ($stashrawline, $rawline); |
| 2481 | |
| 2482 | #warn "line<$line>\n"; |
| 2483 | |
| 2484 | } elsif ($realcnt == 1) { |
| 2485 | $realcnt--; |
| 2486 | } |
| 2487 | |
| 2488 | my $hunk_line = ($realcnt != 0); |
| 2489 | |
| 2490 | $here = "#$linenr: " if (!$file); |
| 2491 | $here = "#$realline: " if ($file); |
| 2492 | |
| 2493 | my $found_file = 0; |
| 2494 | # extract the filename as it passes |
| 2495 | if ($line =~ /^diff --git.*?(\S+)$/) { |
| 2496 | $realfile = $1; |
| 2497 | $realfile =~ s@^([^/]*)/@@ if (!$file); |
| 2498 | $in_commit_log = 0; |
| 2499 | $found_file = 1; |
| 2500 | } elsif ($line =~ /^\+\+\+\s+(\S+)/) { |
| 2501 | $realfile = $1; |
| 2502 | $realfile =~ s@^([^/]*)/@@ if (!$file); |
| 2503 | $in_commit_log = 0; |
| 2504 | |
| 2505 | $p1_prefix = $1; |
| 2506 | if (!$file && $tree && $p1_prefix ne '' && |
| 2507 | -e "$root/$p1_prefix") { |
| 2508 | WARN("PATCH_PREFIX", |
| 2509 | "patch prefix '$p1_prefix' exists, appears to be a -p0 patch\n"); |
| 2510 | } |
| 2511 | |
| 2512 | if ($realfile =~ m@^include/asm/@) { |
| 2513 | ERROR("MODIFIED_INCLUDE_ASM", |
| 2514 | "do not modify files in include/asm, change architecture specific files in include/asm-<architecture>\n" . "$here$rawline\n"); |
| 2515 | } |
| 2516 | $found_file = 1; |
| 2517 | } |
| 2518 | |
| 2519 | #make up the handle for any error we report on this line |
| 2520 | if ($showfile) { |
| 2521 | $prefix = "$realfile:$realline: " |
| 2522 | } elsif ($emacs) { |
| 2523 | if ($file) { |
| 2524 | $prefix = "$filename:$realline: "; |
| 2525 | } else { |
| 2526 | $prefix = "$filename:$linenr: "; |
| 2527 | } |
| 2528 | } |
| 2529 | |
| 2530 | if ($found_file) { |
| 2531 | if (is_maintained_obsolete($realfile)) { |
| 2532 | WARN("OBSOLETE", |
| 2533 | "$realfile is marked as 'obsolete' in the MAINTAINERS hierarchy. No unnecessary modifications please.\n"); |
| 2534 | } |
| 2535 | if ($realfile =~ m@^(?:drivers/net/|net/|drivers/staging/)@) { |
| 2536 | $check = 1; |
| 2537 | } else { |
| 2538 | $check = $check_orig; |
| 2539 | } |
| 2540 | $checklicenseline = 1; |
| 2541 | |
| 2542 | if ($realfile !~ /^MAINTAINERS/) { |
| 2543 | my $last_binding_patch = $is_binding_patch; |
| 2544 | |
| 2545 | $is_binding_patch = () = $realfile =~ m@^(?:Documentation/devicetree/|include/dt-bindings/)@; |
| 2546 | |
| 2547 | if (($last_binding_patch != -1) && |
| 2548 | ($last_binding_patch ^ $is_binding_patch)) { |
| 2549 | WARN("DT_SPLIT_BINDING_PATCH", |
| 2550 | "DT binding docs and includes should be a separate patch. See: Documentation/devicetree/bindings/submitting-patches.txt\n"); |
| 2551 | } |
| 2552 | } |
| 2553 | |
| 2554 | next; |
| 2555 | } |
| 2556 | |
| 2557 | $here .= "FILE: $realfile:$realline:" if ($realcnt != 0); |
| 2558 | |
| 2559 | my $hereline = "$here\n$rawline\n"; |
| 2560 | my $herecurr = "$here\n$rawline\n"; |
| 2561 | my $hereprev = "$here\n$prevrawline\n$rawline\n"; |
| 2562 | |
| 2563 | $cnt_lines++ if ($realcnt != 0); |
| 2564 | |
| 2565 | # Verify the existence of a commit log if appropriate |
| 2566 | # 2 is used because a $signature is counted in $commit_log_lines |
| 2567 | if ($in_commit_log) { |
| 2568 | if ($line !~ /^\s*$/) { |
| 2569 | $commit_log_lines++; #could be a $signature |
| 2570 | } |
| 2571 | } elsif ($has_commit_log && $commit_log_lines < 2) { |
| 2572 | WARN("COMMIT_MESSAGE", |
| 2573 | "Missing commit description - Add an appropriate one\n"); |
| 2574 | $commit_log_lines = 2; #warn only once |
| 2575 | } |
| 2576 | |
| 2577 | # Check if the commit log has what seems like a diff which can confuse patch |
| 2578 | if ($in_commit_log && !$commit_log_has_diff && |
| 2579 | (($line =~ m@^\s+diff\b.*a/([\w/]+)@ && |
| 2580 | $line =~ m@^\s+diff\b.*a/[\w/]+\s+b/$1\b@) || |
| 2581 | $line =~ m@^\s*(?:\-\-\-\s+a/|\+\+\+\s+b/)@ || |
| 2582 | $line =~ m/^\s*\@\@ \-\d+,\d+ \+\d+,\d+ \@\@/)) { |
| 2583 | ERROR("DIFF_IN_COMMIT_MSG", |
| 2584 | "Avoid using diff content in the commit message - patch(1) might not work\n" . $herecurr); |
| 2585 | $commit_log_has_diff = 1; |
| 2586 | } |
| 2587 | |
| 2588 | # Check for incorrect file permissions |
| 2589 | if ($line =~ /^new (file )?mode.*[7531]\d{0,2}$/) { |
| 2590 | my $permhere = $here . "FILE: $realfile\n"; |
| 2591 | if ($realfile !~ m@scripts/@ && |
| 2592 | $realfile !~ /\.(py|pl|awk|sh)$/) { |
| 2593 | ERROR("EXECUTE_PERMISSIONS", |
| 2594 | "do not set execute permissions for source files\n" . $permhere); |
| 2595 | } |
| 2596 | } |
| 2597 | |
| 2598 | # Check the patch for a From: |
| 2599 | if (decode("MIME-Header", $line) =~ /^From:\s*(.*)/) { |
| 2600 | $author = $1; |
| 2601 | $author = encode("utf8", $author) if ($line =~ /=\?utf-8\?/i); |
| 2602 | $author =~ s/"//g; |
| 2603 | } |
| 2604 | |
| 2605 | # Check the patch for a signoff: |
| 2606 | if ($line =~ /^\s*signed-off-by:/i) { |
| 2607 | $signoff++; |
| 2608 | $in_commit_log = 0; |
| 2609 | if ($author ne '') { |
| 2610 | my $l = $line; |
| 2611 | $l =~ s/"//g; |
| 2612 | if ($l =~ /^\s*signed-off-by:\s*\Q$author\E/i) { |
| 2613 | $authorsignoff = 1; |
| 2614 | } |
| 2615 | } |
| 2616 | } |
| 2617 | |
| 2618 | # Check if MAINTAINERS is being updated. If so, there's probably no need to |
| 2619 | # emit the "does MAINTAINERS need updating?" message on file add/move/delete |
| 2620 | if ($line =~ /^\s*MAINTAINERS\s*\|/) { |
| 2621 | $reported_maintainer_file = 1; |
| 2622 | } |
| 2623 | |
| 2624 | # Check signature styles |
| 2625 | if (!$in_header_lines && |
| 2626 | $line =~ /^(\s*)([a-z0-9_-]+by:|$signature_tags)(\s*)(.*)/i) { |
| 2627 | my $space_before = $1; |
| 2628 | my $sign_off = $2; |
| 2629 | my $space_after = $3; |
| 2630 | my $email = $4; |
| 2631 | my $ucfirst_sign_off = ucfirst(lc($sign_off)); |
| 2632 | |
| 2633 | if ($sign_off !~ /$signature_tags/) { |
| 2634 | WARN("BAD_SIGN_OFF", |
| 2635 | "Non-standard signature: $sign_off\n" . $herecurr); |
| 2636 | } |
| 2637 | if (defined $space_before && $space_before ne "") { |
| 2638 | if (WARN("BAD_SIGN_OFF", |
| 2639 | "Do not use whitespace before $ucfirst_sign_off\n" . $herecurr) && |
| 2640 | $fix) { |
| 2641 | $fixed[$fixlinenr] = |
| 2642 | "$ucfirst_sign_off $email"; |
| 2643 | } |
| 2644 | } |
| 2645 | if ($sign_off =~ /-by:$/i && $sign_off ne $ucfirst_sign_off) { |
| 2646 | if (WARN("BAD_SIGN_OFF", |
| 2647 | "'$ucfirst_sign_off' is the preferred signature form\n" . $herecurr) && |
| 2648 | $fix) { |
| 2649 | $fixed[$fixlinenr] = |
| 2650 | "$ucfirst_sign_off $email"; |
| 2651 | } |
| 2652 | |
| 2653 | } |
| 2654 | if (!defined $space_after || $space_after ne " ") { |
| 2655 | if (WARN("BAD_SIGN_OFF", |
| 2656 | "Use a single space after $ucfirst_sign_off\n" . $herecurr) && |
| 2657 | $fix) { |
| 2658 | $fixed[$fixlinenr] = |
| 2659 | "$ucfirst_sign_off $email"; |
| 2660 | } |
| 2661 | } |
| 2662 | |
| 2663 | my ($email_name, $email_address, $comment) = parse_email($email); |
| 2664 | my $suggested_email = format_email(($email_name, $email_address)); |
| 2665 | if ($suggested_email eq "") { |
| 2666 | ERROR("BAD_SIGN_OFF", |
| 2667 | "Unrecognized email address: '$email'\n" . $herecurr); |
| 2668 | } else { |
| 2669 | my $dequoted = $suggested_email; |
| 2670 | $dequoted =~ s/^"//; |
| 2671 | $dequoted =~ s/" </ </; |
| 2672 | # Don't force email to have quotes |
| 2673 | # Allow just an angle bracketed address |
| 2674 | if ("$dequoted$comment" ne $email && |
| 2675 | "<$email_address>$comment" ne $email && |
| 2676 | "$suggested_email$comment" ne $email) { |
| 2677 | WARN("BAD_SIGN_OFF", |
| 2678 | "email address '$email' might be better as '$suggested_email$comment'\n" . $herecurr); |
| 2679 | } |
| 2680 | } |
| 2681 | |
| 2682 | # Check for duplicate signatures |
| 2683 | my $sig_nospace = $line; |
| 2684 | $sig_nospace =~ s/\s//g; |
| 2685 | $sig_nospace = lc($sig_nospace); |
| 2686 | if (defined $signatures{$sig_nospace}) { |
| 2687 | WARN("BAD_SIGN_OFF", |
| 2688 | "Duplicate signature\n" . $herecurr); |
| 2689 | } else { |
| 2690 | $signatures{$sig_nospace} = 1; |
| 2691 | } |
| 2692 | |
| 2693 | # Check Co-developed-by: immediately followed by Signed-off-by: with same name and email |
| 2694 | if ($sign_off =~ /^co-developed-by:$/i) { |
| 2695 | if ($email eq $author) { |
| 2696 | WARN("BAD_SIGN_OFF", |
| 2697 | "Co-developed-by: should not be used to attribute nominal patch author '$author'\n" . "$here\n" . $rawline); |
| 2698 | } |
| 2699 | if (!defined $lines[$linenr]) { |
| 2700 | WARN("BAD_SIGN_OFF", |
| 2701 | "Co-developed-by: must be immediately followed by Signed-off-by:\n" . "$here\n" . $rawline); |
| 2702 | } elsif ($rawlines[$linenr] !~ /^\s*signed-off-by:\s*(.*)/i) { |
| 2703 | WARN("BAD_SIGN_OFF", |
| 2704 | "Co-developed-by: must be immediately followed by Signed-off-by:\n" . "$here\n" . $rawline . "\n" .$rawlines[$linenr]); |
| 2705 | } elsif ($1 ne $email) { |
| 2706 | WARN("BAD_SIGN_OFF", |
| 2707 | "Co-developed-by and Signed-off-by: name/email do not match \n" . "$here\n" . $rawline . "\n" .$rawlines[$linenr]); |
| 2708 | } |
| 2709 | } |
| 2710 | } |
| 2711 | |
| 2712 | # Check email subject for common tools that don't need to be mentioned |
| 2713 | if ($in_header_lines && |
| 2714 | $line =~ /^Subject:.*\b(?:checkpatch|sparse|smatch)\b[^:]/i) { |
| 2715 | WARN("EMAIL_SUBJECT", |
| 2716 | "A patch subject line should describe the change not the tool that found it\n" . $herecurr); |
| 2717 | } |
| 2718 | |
| 2719 | # Check for unwanted Gerrit info |
| 2720 | if ($in_commit_log && $line =~ /^\s*change-id:/i) { |
| 2721 | ERROR("GERRIT_CHANGE_ID", |
| 2722 | "Remove Gerrit Change-Id's before submitting upstream.\n" . $herecurr); |
| 2723 | } |
| 2724 | |
| 2725 | # Check if the commit log is in a possible stack dump |
| 2726 | if ($in_commit_log && !$commit_log_possible_stack_dump && |
| 2727 | ($line =~ /^\s*(?:WARNING:|BUG:)/ || |
| 2728 | $line =~ /^\s*\[\s*\d+\.\d{6,6}\s*\]/ || |
| 2729 | # timestamp |
| 2730 | $line =~ /^\s*\[\<[0-9a-fA-F]{8,}\>\]/) || |
| 2731 | $line =~ /^(?:\s+\w+:\s+[0-9a-fA-F]+){3,3}/ || |
| 2732 | $line =~ /^\s*\#\d+\s*\[[0-9a-fA-F]+\]\s*\w+ at [0-9a-fA-F]+/) { |
| 2733 | # stack dump address styles |
| 2734 | $commit_log_possible_stack_dump = 1; |
| 2735 | } |
| 2736 | |
| 2737 | # Check for line lengths > 75 in commit log, warn once |
| 2738 | if ($in_commit_log && !$commit_log_long_line && |
| 2739 | length($line) > 75 && |
| 2740 | !($line =~ /^\s*[a-zA-Z0-9_\/\.]+\s+\|\s+\d+/ || |
| 2741 | # file delta changes |
| 2742 | $line =~ /^\s*(?:[\w\.\-]+\/)++[\w\.\-]+:/ || |
| 2743 | # filename then : |
| 2744 | $line =~ /^\s*(?:Fixes:|Link:)/i || |
| 2745 | # A Fixes: or Link: line |
| 2746 | $commit_log_possible_stack_dump)) { |
| 2747 | WARN("COMMIT_LOG_LONG_LINE", |
| 2748 | "Possible unwrapped commit description (prefer a maximum 75 chars per line)\n" . $herecurr); |
| 2749 | $commit_log_long_line = 1; |
| 2750 | } |
| 2751 | |
| 2752 | # Reset possible stack dump if a blank line is found |
| 2753 | if ($in_commit_log && $commit_log_possible_stack_dump && |
| 2754 | $line =~ /^\s*$/) { |
| 2755 | $commit_log_possible_stack_dump = 0; |
| 2756 | } |
| 2757 | |
| 2758 | # Check for git id commit length and improperly formed commit descriptions |
| 2759 | if ($in_commit_log && !$commit_log_possible_stack_dump && |
| 2760 | $line !~ /^\s*(?:Link|Patchwork|http|https|BugLink):/i && |
| 2761 | $line !~ /^This reverts commit [0-9a-f]{7,40}/ && |
| 2762 | ($line =~ /\bcommit\s+[0-9a-f]{5,}\b/i || |
| 2763 | ($line =~ /(?:\s|^)[0-9a-f]{12,40}(?:[\s"'\(\[]|$)/i && |
| 2764 | $line !~ /[\<\[][0-9a-f]{12,40}[\>\]]/i && |
| 2765 | $line !~ /\bfixes:\s*[0-9a-f]{12,40}/i))) { |
| 2766 | my $init_char = "c"; |
| 2767 | my $orig_commit = ""; |
| 2768 | my $short = 1; |
| 2769 | my $long = 0; |
| 2770 | my $case = 1; |
| 2771 | my $space = 1; |
| 2772 | my $hasdesc = 0; |
| 2773 | my $hasparens = 0; |
| 2774 | my $id = '0123456789ab'; |
| 2775 | my $orig_desc = "commit description"; |
| 2776 | my $description = ""; |
| 2777 | |
| 2778 | if ($line =~ /\b(c)ommit\s+([0-9a-f]{5,})\b/i) { |
| 2779 | $init_char = $1; |
| 2780 | $orig_commit = lc($2); |
| 2781 | } elsif ($line =~ /\b([0-9a-f]{12,40})\b/i) { |
| 2782 | $orig_commit = lc($1); |
| 2783 | } |
| 2784 | |
| 2785 | $short = 0 if ($line =~ /\bcommit\s+[0-9a-f]{12,40}/i); |
| 2786 | $long = 1 if ($line =~ /\bcommit\s+[0-9a-f]{41,}/i); |
| 2787 | $space =
|