Date: Sat, 25 Mar 2023 13:22:21 -0400 From: "Drew Gallatin" <gallatin@freebsd.org> To: "Warner Losh" <imp@FreeBSD.org>, src-committers@FreeBSD.org, dev-commits-src-all@FreeBSD.org, dev-commits-src-main@FreeBSD.org Subject: Re: git: 3a3c9242739e - main - checkstyle9.pl: Perl script to check if a change is approximately style(9) Message-ID: <5b9c31d2-4aaf-4822-b405-cae57164f314@app.fastmail.com> In-Reply-To: <202303251708.32PH8BUq079177@gitrepo.freebsd.org> References: <202303251708.32PH8BUq079177@gitrepo.freebsd.org>
next in thread | previous in thread | raw e-mail | index | archive | help
--d2b24846419d49c4ab1b06d629e431e9 Content-Type: text/plain Thanks so much. I've wanted something like this *forever* On Sat, Mar 25, 2023, at 1:08 PM, Warner Losh wrote: > The branch main has been updated by imp: > > URL: https://cgit.FreeBSD.org/src/commit/?id=3a3c9242739efb0c76587ffbaa54c5d10b2cbcb4 <https://cgit.freebsd.org/src/commit/?id=3a3c9242739efb0c76587ffbaa54c5d10b2cbcb4>; > > commit 3a3c9242739efb0c76587ffbaa54c5d10b2cbcb4 > Author: Warner Losh <imp@FreeBSD.org> > AuthorDate: 2023-03-14 21:28:05 +0000 > Commit: Warner Losh <imp@FreeBSD.org> > CommitDate: 2023-03-25 17:06:13 +0000 > > checkstyle9.pl: Perl script to check if a change is approximately style(9) > > This code is adapted from the QEMU checkpatch.pl script. It can check > either a patch, a file or a git branch. It tries to warn about things > that I believe might be style(9) violations. It's experimental, since I > heavily hacked on the qemu version to get it to not complain (much) > about iconic code in the tree. At the moment, it's use should be > considered expermental. It will likely miss violations, and complain > about code that's perfectly fine. It's offered as an experiment > and to make it easier for contributors to submit patches. > --- > tools/build/checkstyle9.pl | 2748 ++++++++++++++++++++++++++++++++++++++++++++ > 1 file changed, 2748 insertions(+) > > diff --git a/tools/build/checkstyle9.pl b/tools/build/checkstyle9.pl > new file mode 100755 > index 000000000000..5aec3819bf7c > --- /dev/null > +++ b/tools/build/checkstyle9.pl > @@ -0,0 +1,2748 @@ > +#!/usr/bin/env perl > +# (c) 2001, Dave Jones. (the file handling bit) > +# (c) 2005, Joel Schopp <jschopp@austin.ibm.com> (the ugly bit) > +# (c) 2007,2008, Andy Whitcroft <apw@uk.ibm.com> (new conditions, test suite) > +# (c) 2008-2010 Andy Whitcroft <apw@canonical.com> > +# Licensed under the terms of the GNU GPL License version 2 > + > +use strict; > +use warnings; > +use Term::ANSIColor qw(:constants); > + > +my $P = $0; > +$P =~ s@.*/@@g; > + > +our $SrcFile = qr{\.(?:h|c|cpp|s|S|pl|py|sh)$}; > + > +my $V = '0.31'; > + > +use Getopt::Long qw(:config no_auto_abbrev); > + > +my $quiet = 0; > +my $tree = 1; > +my $chk_signoff = 1; > +my $chk_patch = undef; > +my $chk_branch = undef; > +my $tst_only; > +my $emacs = 0; > +my $terse = 0; > +my $file = undef; > +my $color = "auto"; > +my $no_warnings = 0; > +my $summary = 1; > +my $mailback = 0; > +my $summary_file = 0; > +my $root; > +my %debug; > +my $help = 0; > + > +sub help { > + my ($exitcode) = @_; > + > + print << "EOM"; > +Usage: > + > + $P [OPTION]... [FILE]... > + $P [OPTION]... [GIT-REV-LIST] > + > +Version: $V > + > +Options: > + -q, --quiet quiet > + --patch treat FILE as patchfile > + --branch treat args as GIT revision list > + --emacs emacs compile window format > + --terse one line per report > + -f, --file treat FILE as regular source file > + --strict fail if only warnings are found > + --no-summary suppress the per-file summary > + --mailback only produce a report in case of warnings/errors > + --summary-file include the filename in summary > + --debug KEY=[0|1] turn on/off debugging of KEY, where KEY is one of > + 'values', 'possible', 'type', and 'attr' (default > + is all off) > + --test-only=WORD report only warnings/errors containing WORD > + literally > + --color[=WHEN] Use colors 'always', 'never', or only when output > + is a terminal ('auto'). Default is 'auto'. > + -h, --help, --version display this help and exit > + > +When FILE is - read standard input. > +EOM > + > + exit($exitcode); > +} > + > +# Use at your own risk > +print "\n", MAGENTA, "WARNING:", RESET, " This code is highly experimental ... likely isn't a great style(9) match yet\n\n"; > + > +# Perl's Getopt::Long allows options to take optional arguments after a space. > +# Prevent --color by itself from consuming other arguments > +foreach (@ARGV) { > + if ($_ eq "--color" || $_ eq "-color") { > + $_ = "--color=$color"; > + } > +} > + > +GetOptions( > + 'q|quiet+' => \$quiet, > + 'tree!' => \$tree, > + 'signoff!' => \$chk_signoff, > + 'patch!' => \$chk_patch, > + 'branch!' => \$chk_branch, > + 'emacs!' => \$emacs, > + 'terse!' => \$terse, > + 'f|file!' => \$file, > + 'strict!' => \$no_warnings, > + 'root=s' => \$root, > + 'summary!' => \$summary, > + 'mailback!' => \$mailback, > + 'summary-file!' => \$summary_file, > + > + 'debug=s' => \%debug, > + 'test-only=s' => \$tst_only, > + 'color=s' => \$color, > + 'no-color' => sub { $color = 'never'; }, > + 'h|help' => \$help, > + 'version' => \$help > +) or help(1); > + > +help(0) if ($help); > + > +my $exit = 0; > + > +if ($#ARGV < 0) { > + print "$P: no input files\n"; > + exit(1); > +} > + > +if (!defined $chk_branch && !defined $chk_patch && !defined $file) { > + $chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0; > + $file = $ARGV[0] =~ /$SrcFile/ ? 1 : 0; > + $chk_patch = $chk_branch || $file ? 0 : 1; > +} elsif (!defined $chk_branch && !defined $chk_patch) { > + if ($file) { > + $chk_branch = $chk_patch = 0; > + } else { > + $chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0; > + $chk_patch = $chk_branch ? 0 : 1; > + } > +} elsif (!defined $chk_branch && !defined $file) { > + if ($chk_patch) { > + $chk_branch = $file = 0; > + } else { > + $chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0; > + $file = $chk_branch ? 0 : 1; > + } > +} elsif (!defined $chk_patch && !defined $file) { > + if ($chk_branch) { > + $chk_patch = $file = 0; > + } else { > + $file = $ARGV[0] =~ /$SrcFile/ ? 1 : 0; > + $chk_patch = $file ? 0 : 1; > + } > +} elsif (!defined $chk_branch) { > + $chk_branch = $chk_patch || $file ? 0 : 1; > +} elsif (!defined $chk_patch) { > + $chk_patch = $chk_branch || $file ? 0 : 1; > +} elsif (!defined $file) { > + $file = $chk_patch || $chk_branch ? 0 : 1; > +} > + > +if (($chk_patch && $chk_branch) || > + ($chk_patch && $file) || > + ($chk_branch && $file)) { > + die "Only one of --file, --branch, --patch is permitted\n"; > +} > +if (!$chk_patch && !$chk_branch && !$file) { > + die "One of --file, --branch, --patch is required\n"; > +} > + > +if ($color =~ /^always$/i) { > + $color = 1; > +} elsif ($color =~ /^never$/i) { > + $color = 0; > +} elsif ($color =~ /^auto$/i) { > + $color = (-t STDOUT); > +} else { > + die "Invalid color mode: $color\n"; > +} > + > +my $dbg_values = 0; > +my $dbg_possible = 0; > +my $dbg_type = 0; > +my $dbg_attr = 0; > +my $dbg_adv_dcs = 0; > +my $dbg_adv_checking = 0; > +my $dbg_adv_apw = 0; > +for my $key (keys %debug) { > + ## no critic > + eval "\${dbg_$key} = '$debug{$key}';"; > + die "$@" if ($@); > +} > + > +my $rpt_cleaners = 0; > + > +if ($terse) { > + $emacs = 1; > + $quiet++; > +} > + > +my $emitted_corrupt = 0; > + > +our $Ident = qr{ > + [A-Za-z_][A-Za-z\d_]* > + (?:\s*\#\#\s*[A-Za-z_][A-Za-z\d_]*)* > + }x; > +our $Storage = qr{extern|static|asmlinkage}; > +our $Sparse = qr{ > + __force > + }x; > + > +# Notes to $Attribute: > +our $Attribute = qr{ > + const| > + volatile| > + QEMU_NORETURN| > + QEMU_WARN_UNUSED_RESULT| > + QEMU_SENTINEL| > + QEMU_PACKED| > + GCC_FMT_ATTR > + }x; > +our $Modifier; > +our $Inline = qr{inline}; > +our $Member = qr{->$Ident|\.$Ident|\[[^]]*\]}; > +our $Lval = qr{$Ident(?:$Member)*}; > + > +our $Constant = qr{(?:[0-9]+|0x[0-9a-fA-F]+)[UL]*}; > +our $Assignment = qr{(?:\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=)}; > +our $Compare = qr{<=|>=|==|!=|<|>}; > +our $Operators = qr{ > + <=|>=|==|!=| > + =>|->|<<|>>|<|>|!|~| > + &&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|% > + }x; > + > +our $NonptrType; > +our $Type; > +our $Declare; > + > +our $NON_ASCII_UTF8 = qr{ > + [\xC2-\xDF][\x80-\xBF] # non-overlong 2-byte > + | \xE0[\xA0-\xBF][\x80-\xBF] # excluding overlongs > + | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2} # straight 3-byte > + | \xED[\x80-\x9F][\x80-\xBF] # excluding surrogates > + | \xF0[\x90-\xBF][\x80-\xBF]{2} # planes 1-3 > + | [\xF1-\xF3][\x80-\xBF]{3} # planes 4-15 > + | \xF4[\x80-\x8F][\x80-\xBF]{2} # plane 16 > +}x; > + > +our $UTF8 = qr{ > + [\x09\x0A\x0D\x20-\x7E] # ASCII > + | $NON_ASCII_UTF8 > +}x; > + > +# some readers default to ISO-8859-1 when showing email source. detect > +# when UTF-8 is incorrectly interpreted as ISO-8859-1 and reencoded back. > +# False positives are possible but very unlikely. > +our $UTF8_MOJIBAKE = qr{ > + \xC3[\x82-\x9F] \xC2[\x80-\xBF] # c2-df 80-bf > + | \xC3\xA0 \xC2[\xA0-\xBF] \xC2[\x80-\xBF] # e0 a0-bf 80-bf > + | \xC3[\xA1-\xAC\xAE\xAF] (?: \xC2[\x80-\xBF]){2} # e1-ec/ee/ef 80-bf 80-bf > + | \xC3\xAD \xC2[\x80-\x9F] \xC2[\x80-\xBF] # ed 80-9f 80-bf > + | \xC3\xB0 \xC2[\x90-\xBF] (?: \xC2[\x80-\xBF]){2} # f0 90-bf 80-bf 80-bf > + | \xC3[\xB1-\xB3] (?: \xC2[\x80-\xBF]){3} # f1-f3 80-bf 80-bf 80-bf > + | \xC3\xB4 \xC2[\x80-\x8F] (?: \xC2[\x80-\xBF]){2} # f4 80-b8 80-bf 80-bf > +}x; > + > +# There are still some false positives, but this catches most > +# common cases. > +our $typeTypedefs = qr{(?x: > + (?![KMGTPE]iB) # IEC binary prefix (do not match) > + [A-Z][A-Z\d_]*[a-z][A-Za-z\d_]* # camelcase > + | [A-Z][A-Z\d_]*AIOCB # all uppercase > + | [A-Z][A-Z\d_]*CPU # all uppercase > + | QEMUBH # all uppercase > +)}; > + > +our @typeList = ( > + qr{void}, > + qr{(?:unsigned\s+)?char}, > + qr{(?:unsigned\s+)?short}, > + qr{(?:unsigned\s+)?int}, > + qr{(?:unsigned\s+)?long}, > + qr{(?:unsigned\s+)?long\s+int}, > + qr{(?:unsigned\s+)?long\s+long}, > + qr{(?:unsigned\s+)?long\s+long\s+int}, > + qr{unsigned}, > + qr{float}, > + qr{double}, > + qr{bool}, > + qr{struct\s+$Ident}, > + qr{union\s+$Ident}, > + qr{enum\s+$Ident}, > + qr{${Ident}_t}, > + qr{${Ident}_handler}, > + qr{${Ident}_handler_fn}, > + qr{target_(?:u)?long}, > + qr{hwaddr}, > +); > + > +# This can be modified by sub possible. Since it can be empty, be careful > +# about regexes that always match, because they can cause infinite loops. > +our @modifierList = ( > +); > + > +sub build_types { > + my $all = "(?x: \n" . join("|\n ", @typeList) . "\n)"; > + if (@modifierList > 0) { > + my $mods = "(?x: \n" . join("|\n ", @modifierList) . "\n)"; > + $Modifier = qr{(?:$Attribute|$Sparse|$mods)}; > + } else { > + $Modifier = qr{(?:$Attribute|$Sparse)}; > + } > + $NonptrType = qr{ > + (?:$Modifier\s+|const\s+)* > + (?: > + (?:typeof|__typeof__)\s*\(\s*\**\s*$Ident\s*\)| > + (?:$typeTypedefs\b)| > + (?:${all}\b) > + ) > + (?:\s+$Modifier|\s+const)* > + }x; > + $Type = qr{ > + $NonptrType > + (?:[\s\*]+\s*const|[\s\*]+|(?:\s*\[\s*\])+)? > + (?:\s+$Inline|\s+$Modifier)* > + }x; > + $Declare = qr{(?:$Storage\s+)?$Type}; > +} > +build_types(); > + > +$chk_signoff = 0 if ($file); > + > +my @rawlines = (); > +my @lines = (); > +my $vname; > +if ($chk_branch) { > + my @patches; > + my %git_commits = (); > + my $HASH; > + open($HASH, "-|", "git", "log", "--reverse", "--no-merges", "--format=%H %s", $ARGV[0]) || > + die "$P: git log --reverse --no-merges --format='%H %s' $ARGV[0] failed - $!\n"; > + > + for my $line (<$HASH>) { > + $line =~ /^([0-9a-fA-F]{40,40}) (.*)$/; > + next if (!defined($1) || !defined($2)); > + my $sha1 = $1; > + my $subject = $2; > + push(@patches, $sha1); > + $git_commits{$sha1} = $subject; > + } > + > + close $HASH; > + > + die "$P: no revisions returned for revlist '$ARGV[0]'\n" > + unless @patches; > + > + my $i = 1; > + my $num_patches = @patches; > + for my $hash (@patches) { > + my $FILE; > + open($FILE, '-|', "git", "show", "--patch-with-stat", $hash) || > + die "$P: git show $hash - $!\n"; > + while (<$FILE>) { > + chomp; > + push(@rawlines, $_); > + } > + close($FILE); > + $vname = substr($hash, 0, 12) . ' (' . $git_commits{$hash} . ')'; > + if ($num_patches > 1 && $quiet == 0) { > + my $prefix = "$i/$num_patches"; > + $prefix = BLUE . BOLD . $prefix . RESET if $color; > + print "$prefix Checking commit $vname\n"; > + $vname = "Patch $i/$num_patches"; > + } else { > + $vname = "Commit " . $vname; > + } > + if (!process($hash)) { > + $exit = 1; > + print "\n" if ($num_patches > 1 && $quiet == 0); > + } > + @rawlines = (); > + @lines = (); > + $i++; > + } > +} else { > + for my $filename (@ARGV) { > + my $FILE; > + if ($file) { > + open($FILE, '-|', "diff -u /dev/null $filename") || > + die "$P: $filename: diff failed - $!\n"; > + } elsif ($filename eq '-') { > + open($FILE, '<&STDIN'); > + } else { > + open($FILE, '<', "$filename") || > + die "$P: $filename: open failed - $!\n"; > + } > + if ($filename eq '-') { > + $vname = 'Your patch'; > + } else { > + $vname = $filename; > + } > + print "Checking $filename...\n" if @ARGV > 1 && $quiet == 0; > + while (<$FILE>) { > + chomp; > + push(@rawlines, $_); > + } > + close($FILE); > + if (!process($filename)) { > + $exit = 1; > + } > + @rawlines = (); > + @lines = (); > + } > +} > + > +exit($exit); > + > +sub top_of_kernel_tree { > + my ($root) = @_; > + > + my @tree_check = ( > + "Makefile.inc1", "README.md", "sys", > + "usr.sbin" > + ); > + > + foreach my $check (@tree_check) { > + if (! -e $root . '/' . $check) { > + return 0; > + } > + } > + return 1; > +} > + > +sub expand_tabs { > + my ($str) = @_; > + > + my $res = ''; > + my $n = 0; > + for my $c (split(//, $str)) { > + if ($c eq "\t") { > + $res .= ' '; > + $n++; > + for (; ($n % 8) != 0; $n++) { > + $res .= ' '; > + } > + next; > + } > + $res .= $c; > + $n++; > + } > + > + return $res; > +} > +sub copy_spacing { > + (my $res = shift) =~ tr/\t/ /c; > + return $res; > +} > + > +sub line_stats { > + my ($line) = @_; > + > + # Drop the diff line leader and expand tabs > + $line =~ s/^.//; > + $line = expand_tabs($line); > + > + # Pick the indent from the front of the line. > + my ($white) = ($line =~ /^(\s*)/); > + > + return (length($line), length($white)); > +} > + > +my $sanitise_quote = ''; > + > +sub sanitise_line_reset { > + my ($in_comment) = @_; > + > + if ($in_comment) { > + $sanitise_quote = '*/'; > + } else { > + $sanitise_quote = ''; > + } > +} > +sub sanitise_line { > + my ($line) = @_; > + > + my $res = ''; > + my $l = ''; > + > + my $qlen = 0; > + my $off = 0; > + my $c; > + > + # Always copy over the diff marker. > + $res = substr($line, 0, 1); > + > + for ($off = 1; $off < length($line); $off++) { > + $c = substr($line, $off, 1); > + > + # Comments we are wacking completely including the begin > + # and end, all to $;. > + if ($sanitise_quote eq '' && substr($line, $off, 2) eq '/*') { > + $sanitise_quote = '*/'; > + > + substr($res, $off, 2, "$;$;"); > + $off++; > + next; > + } > + if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') { > + $sanitise_quote = ''; > + substr($res, $off, 2, "$;$;"); > + $off++; > + next; > + } > + if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') { > + $sanitise_quote = '//'; > + > + substr($res, $off, 2, $sanitise_quote); > + $off++; > + next; > + } > + > + # A \ in a string means ignore the next character. > + if (($sanitise_quote eq "'" || $sanitise_quote eq '"') && > + $c eq "\\") { > + substr($res, $off, 2, 'XX'); > + $off++; > + next; > + } > + # Regular quotes. > + if ($c eq "'" || $c eq '"') { > + if ($sanitise_quote eq '') { > + $sanitise_quote = $c; > + > + substr($res, $off, 1, $c); > + next; > + } elsif ($sanitise_quote eq $c) { > + $sanitise_quote = ''; > + } > + } > + > + #print "c<$c> SQ<$sanitise_quote>\n"; > + if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") { > + substr($res, $off, 1, $;); > + } elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") { > + substr($res, $off, 1, $;); > + } elsif ($off != 0 && $sanitise_quote && $c ne "\t") { > + substr($res, $off, 1, 'X'); > + } else { > + substr($res, $off, 1, $c); > + } > + } > + > + if ($sanitise_quote eq '//') { > + $sanitise_quote = ''; > + } > + > + # The pathname on a #include may be surrounded by '<' and '>'. > + if ($res =~ /^.\s*\#\s*include\s+\<(.*)\>/) { > + my $clean = 'X' x length($1); > + $res =~ s@\<.*\>@<$clean>@; > + > + # The whole of a #error is a string. > + } elsif ($res =~ /^.\s*\#\s*(?:error|warning)\s+(.*)\b/) { > + my $clean = 'X' x length($1); > + $res =~ s@(\#\s*(?:error|warning)\s+).*@$1$clean@; > + } > + > + return $res; > +} > + > +sub ctx_statement_block { > + my ($linenr, $remain, $off) = @_; > + my $line = $linenr - 1; > + my $blk = ''; > + my $soff = $off; > + my $coff = $off - 1; > + my $coff_set = 0; > + > + my $loff = 0; > + > + my $type = ''; > + my $level = 0; > + my @stack = (); > + my $p; > + my $c; > + my $len = 0; > + > + my $remainder; > + while (1) { > + @stack = (['', 0]) if ($#stack == -1); > + > + #warn "CSB: blk<$blk> remain<$remain>\n"; > + # If we are about to drop off the end, pull in more > + # context. > + if ($off >= $len) { > + for (; $remain > 0; $line++) { > + last if (!defined $lines[$line]); > + next if ($lines[$line] =~ /^-/); > + $remain--; > + $loff = $len; > + $blk .= $lines[$line] . "\n"; > + $len = length($blk); > + $line++; > + last; > + } > + # Bail if there is no further context. > + #warn "CSB: blk<$blk> off<$off> len<$len>\n"; > + if ($off >= $len) { > + last; > + } > + } > + $p = $c; > + $c = substr($blk, $off, 1); > + $remainder = substr($blk, $off); > + > + #warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>\n"; > + > + # Handle nested #if/#else. > + if ($remainder =~ /^#\s*(?:ifndef|ifdef|if)\s/) { > + push(@stack, [ $type, $level ]); > + } elsif ($remainder =~ /^#\s*(?:else|elif)\b/) { > + ($type, $level) = @{$stack[$#stack - 1]}; > + } elsif ($remainder =~ /^#\s*endif\b/) { > + ($type, $level) = @{pop(@stack)}; > + } > + > + # Statement ends at the ';' or a close '}' at the > + # outermost level. > + if ($level == 0 && $c eq ';') { > + last; > + } > + > + # An else is really a conditional as long as its not else if > + if ($level == 0 && $coff_set == 0 && > + (!defined($p) || $p =~ /(?:\s|\}|\+)/) && > + $remainder =~ /^(else)(?:\s|{)/ && > + $remainder !~ /^else\s+if\b/) { > + $coff = $off + length($1) - 1; > + $coff_set = 1; > + #warn "CSB: mark coff<$coff> soff<$soff> 1<$1>\n"; > + #warn "[" . substr($blk, $soff, $coff - $soff + 1) . "]\n"; > + } > + > + if (($type eq '' || $type eq '(') && $c eq '(') { > + $level++; > + $type = '('; > + } > + if ($type eq '(' && $c eq ')') { > + $level--; > + $type = ($level != 0)? '(' : ''; > + > + if ($level == 0 && $coff < $soff) { > + $coff = $off; > + $coff_set = 1; > + #warn "CSB: mark coff<$coff>\n"; > + } > + } > + if (($type eq '' || $type eq '{') && $c eq '{') { > + $level++; > + $type = '{'; > + } > + if ($type eq '{' && $c eq '}') { > + $level--; > + $type = ($level != 0)? '{' : ''; > + > + if ($level == 0) { > + if (substr($blk, $off + 1, 1) eq ';') { > + $off++; > + } > + last; > + } > + } > + $off++; > + } > + # We are truly at the end, so shuffle to the next line. > + if ($off == $len) { > + $loff = $len + 1; > + $line++; > + $remain--; > + } > + > + my $statement = substr($blk, $soff, $off - $soff + 1); > + my $condition = substr($blk, $soff, $coff - $soff + 1); > + > + #warn "STATEMENT<$statement>\n"; > + #warn "CONDITION<$condition>\n"; > + > + #print "coff<$coff> soff<$off> loff<$loff>\n"; > + > + return ($statement, $condition, > + $line, $remain + 1, $off - $loff + 1, $level); > +} > + > +sub statement_lines { > + my ($stmt) = @_; > + > + # Strip the diff line prefixes and rip blank lines at start and end. > + $stmt =~ s/(^|\n)./$1/g; > + $stmt =~ s/^\s*//; > + $stmt =~ s/\s*$//; > + > + my @stmt_lines = ($stmt =~ /\n/g); > + > + return $#stmt_lines + 2; > +} > + > +sub statement_rawlines { > + my ($stmt) = @_; > + > + my @stmt_lines = ($stmt =~ /\n/g); > + > + return $#stmt_lines + 2; > +} > + > +sub statement_block_size { > + my ($stmt) = @_; > + > + $stmt =~ s/(^|\n)./$1/g; > + $stmt =~ s/^\s*\{//; > + $stmt =~ s/}\s*$//; > + $stmt =~ s/^\s*//; > + $stmt =~ s/\s*$//; > + > + my @stmt_lines = ($stmt =~ /\n/g); > + my @stmt_statements = ($stmt =~ /;/g); > + > + my $stmt_lines = $#stmt_lines + 2; > + my $stmt_statements = $#stmt_statements + 1; > + > + if ($stmt_lines > $stmt_statements) { > + return $stmt_lines; > + } else { > + return $stmt_statements; > + } > +} > + > +sub ctx_statement_full { > + my ($linenr, $remain, $off) = @_; > + my ($statement, $condition, $level); > + > + my (@chunks); > + > + # Grab the first conditional/block pair. > + ($statement, $condition, $linenr, $remain, $off, $level) = > + ctx_statement_block($linenr, $remain, $off); > + #print "F: c<$condition> s<$statement> remain<$remain>\n"; > + push(@chunks, [ $condition, $statement ]); > + if (!($remain > 0 && $condition =~ /^\s*(?:\n[+-])?\s*(?:if|else|do)\b/s)) { > + return ($level, $linenr, @chunks); > + } > + > + # Pull in the following conditional/block pairs and see if they > + # could continue the statement. > + for (;;) { > + ($statement, $condition, $linenr, $remain, $off, $level) = > + ctx_statement_block($linenr, $remain, $off); > + #print "C: c<$condition> s<$statement> remain<$remain>\n"; > + last if (!($remain > 0 && $condition =~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s)); > + #print "C: push\n"; > + push(@chunks, [ $condition, $statement ]); > + } > + > + return ($level, $linenr, @chunks); > +} > + > +sub ctx_block_get { > + my ($linenr, $remain, $outer, $open, $close, $off) = @_; > + my $line; > + my $start = $linenr - 1; > + my $blk = ''; > + my @o; > + my @c; > + my @res = (); > + > + my $level = 0; > + my @stack = ($level); > + for ($line = $start; $remain > 0; $line++) { > + next if ($rawlines[$line] =~ /^-/); > + $remain--; > + > + $blk .= $rawlines[$line]; > + > + # Handle nested #if/#else. > + if ($lines[$line] =~ /^.\s*#\s*(?:ifndef|ifdef|if)\s/) { > + push(@stack, $level); > + } elsif ($lines[$line] =~ /^.\s*#\s*(?:else|elif)\b/) { > + $level = $stack[$#stack - 1]; > + } elsif ($lines[$line] =~ /^.\s*#\s*endif\b/) { > + $level = pop(@stack); > + } > + > + foreach my $c (split(//, $lines[$line])) { > + ##print "C<$c>L<$level><$open$close>O<$off>\n"; > + if ($off > 0) { > + $off--; > + next; > + } > + > + if ($c eq $close && $level > 0) { > + $level--; > + last if ($level == 0); > + } elsif ($c eq $open) { > + $level++; > + } > + } > + > + if (!$outer || $level <= 1) { > + push(@res, $rawlines[$line]); > + } > + > + last if ($level == 0); > + } > + > + return ($level, @res); > +} > +sub ctx_block_outer { > + my ($linenr, $remain) = @_; > + > + my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0); > + return @r; > +} > +sub ctx_block { > + my ($linenr, $remain) = @_; > + > + my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0); > + return @r; > +} > +sub ctx_statement { > + my ($linenr, $remain, $off) = @_; > + > + my ($level, @r) = ctx_block_get($linenr, $remain, 0, '(', ')', $off); > + return @r; > +} > +sub ctx_block_level { > + my ($linenr, $remain) = @_; > + > + return ctx_block_get($linenr, $remain, 0, '{', '}', 0); > +} > +sub ctx_statement_level { > + my ($linenr, $remain, $off) = @_; > + > + return ctx_block_get($linenr, $remain, 0, '(', ')', $off); > +} > + > +sub ctx_locate_comment { > + my ($first_line, $end_line) = @_; > + > + # Catch a comment on the end of the line itself. > + my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@); > + return $current_comment if (defined $current_comment); > + > + # Look through the context and try and figure out if there is a > + # comment. > + my $in_comment = 0; > + $current_comment = ''; > + for (my $linenr = $first_line; $linenr < $end_line; $linenr++) { > + my $line = $rawlines[$linenr - 1]; > + #warn " $line\n"; > + if ($linenr == $first_line and $line =~ m@^.\s*\*@) { > + $in_comment = 1; > + } > + if ($line =~ m@/\*@) { > + $in_comment = 1; > + } > + if (!$in_comment && $current_comment ne '') { > + $current_comment = ''; > + } > + $current_comment .= $line . "\n" if ($in_comment); > + if ($line =~ m@\*/@) { > + $in_comment = 0; > + } > + } > + > + chomp($current_comment); > + return($current_comment); > +} > +sub ctx_has_comment { > + my ($first_line, $end_line) = @_; > + my $cmt = ctx_locate_comment($first_line, $end_line); > + > + ##print "LINE: $rawlines[$end_line - 1 ]\n"; > + ##print "CMMT: $cmt\n"; > + > + return ($cmt ne ''); > +} > + > +sub raw_line { > + my ($linenr, $cnt) = @_; > + > + my $offset = $linenr - 1; > + $cnt++; > + > + my $line; > + while ($cnt) { > + $line = $rawlines[$offset++]; > + next if (defined($line) && $line =~ /^-/); > + $cnt--; > + } > + > + return $line; > +} > + > +sub cat_vet { > + my ($vet) = @_; > + my ($res, $coded); > + > + $res = ''; > + while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) { > + $res .= $1; > + if ($2 ne '') { > + $coded = sprintf("^%c", unpack('C', $2) + 64); > + $res .= $coded; > + } > + } > + $res =~ s/$/\$/; > + > + return $res; > +} > + > +my $av_preprocessor = 0; > +my $av_pending; > +my @av_paren_type; > +my $av_pend_colon; > + > +sub annotate_reset { > + $av_preprocessor = 0; > + $av_pending = '_'; > + @av_paren_type = ('E'); > + $av_pend_colon = 'O'; > +} > + > +sub annotate_values { > + my ($stream, $type) = @_; > + > + my $res; > + my $var = '_' x length($stream); > + my $cur = $stream; > + > + print "$stream\n" if ($dbg_values > 1); > + > + while (length($cur)) { > + @av_paren_type = ('E') if ($#av_paren_type < 0); > + print " <" . join('', @av_paren_type) . > + "> <$type> <$av_pending>" if ($dbg_values > 1); > + if ($cur =~ /^(\s+)/o) { > + print "WS($1)\n" if ($dbg_values > 1); > + if ($1 =~ /\n/ && $av_preprocessor) { > + $type = pop(@av_paren_type); > + $av_preprocessor = 0; > + } > + > + } elsif ($cur =~ /^(\(\s*$Type\s*)\)/ && $av_pending eq '_') { > + print "CAST($1)\n" if ($dbg_values > 1); > + push(@av_paren_type, $type); > + $type = 'C'; > + > + } elsif ($cur =~ /^($Type)\s*(?:$Ident|,|\)|\(|\s*$)/) { > + print "DECLARE($1)\n" if ($dbg_values > 1); > + $type = 'T'; > + > + } elsif ($cur =~ /^($Modifier)\s*/) { > + print "MODIFIER($1)\n" if ($dbg_values > 1); > + $type = 'T'; > + > + } elsif ($cur =~ /^(\#\s*define\s*$Ident)(\(?)/o) { > + print "DEFINE($1,$2)\n" if ($dbg_values > 1); > *** 1791 LINES SKIPPED *** > --d2b24846419d49c4ab1b06d629e431e9 Content-Type: text/html Content-Transfer-Encoding: quoted-printable <!DOCTYPE html><html><head><title></title><style type=3D"text/css">p.Mso= Normal,p.MsoNoSpacing{margin:0}</style></head><body><div>Thanks so much.= I've wanted something like this *forever*<br></div><div><br></div= ><div>On Sat, Mar 25, 2023, at 1:08 PM, Warner Losh wrote:<br></div><blo= ckquote type=3D"cite" id=3D"qt" style=3D""><div>The branch main has been= updated by imp:<br></div><div><br></div><div>URL: <a href=3D"https= ://cgit.FreeBSD.org/src/commit/?id=3D3a3c9242739efb0c76587ffbaa54c5d10b2= cbcb4">https://cgit.FreeBSD.org/src/commit/?id=3D3a3c9242739efb0c76587ff= baa54c5d10b2cbcb4</a><br></div><div><br></div><div>commit 3a3c9242739efb= 0c76587ffbaa54c5d10b2cbcb4<br></div><div>Author: = Warner Losh <<a href=3D"mailto:imp@FreeBSD.org">imp@FreeBSD.org</a>&= gt;<br></div><div>AuthorDate: 2023-03-14 21:28:05 +0000<br></div><div>Co= mmit: Warner Losh <<a href=3D"mailto:imp@Free= BSD.org">imp@FreeBSD.org</a>><br></div><div>CommitDate: 2023-03-25 17= :06:13 +0000<br></div><div><br></div><div> checkstyle9= .pl: Perl script to check if a change is approximately style(9)<br></div= ><div> <br></div><div> This cod= e is adapted from the QEMU checkpatch.pl script. It can check<br></div><= div> either a patch, a file or a git branch. It tries = to warn about things<br></div><div> that I believe mig= ht be style(9) violations. It's experimental, since I<br></div><div>&nbs= p; heavily hacked on the qemu version to get it to not compl= ain (much)<br></div><div> about iconic code in the tre= e. At the moment, it's use should be<br></div><div> co= nsidered expermental. It will likely miss violations, and complain<br></= div><div> about code that's perfectly fine. It's= offered as an experiment<br></div><div> and to make i= t easier for contributors to submit patches.<br></div><div>---<br></div>= <div>tools/build/checkstyle9.pl | 2748 +++++++++++++++++++++++++++++++++= +++++++++++<br></div><div>1 file changed, 2748 insertions(+)<br></div><d= iv><br></div><div>diff --git a/tools/build/checkstyle9.pl b/tools/build/= checkstyle9.pl<br></div><div>new file mode 100755<br></div><div>index 00= 0000000000..5aec3819bf7c<br></div><div>--- /dev/null<br></div><div>+++ b= /tools/build/checkstyle9.pl<br></div><div>@@ -0,0 +1,2748 @@<br></div><d= iv>+#!/usr/bin/env perl<br></div><div>+# (c) 2001, Dave Jones. (the file= handling bit)<br></div><div>+# (c) 2005, Joel Schopp <<a href=3D"mai= lto:jschopp@austin.ibm.com">jschopp@austin.ibm.com</a>> (the ugly bit= )<br></div><div>+# (c) 2007,2008, Andy Whitcroft <<a href=3D"mailto:a= pw@uk.ibm.com">apw@uk.ibm.com</a>> (new conditions, test suite)<br></= div><div>+# (c) 2008-2010 Andy Whitcroft <<a href=3D"mailto:apw@canon= ical.com">apw@canonical.com</a>><br></div><div>+# Licensed under the = terms of the GNU GPL License version 2<br></div><div>+<br></div><div>+us= e strict;<br></div><div>+use warnings;<br></div><div>+use Term::ANSIColo= r qw(:constants);<br></div><div>+<br></div><div>+my $P =3D $0;<br></div>= <div>+$P =3D~ s@.*/@@g;<br></div><div>+<br></div><div>+our $SrcFile = ; =3D qr{\.(?:h|c|cpp|s|S|pl|py|sh)$};<br></div><div>+<br></= div><div>+my $V =3D '0.31';<br></div><div>+<br></div><div>+use Getopt::L= ong qw(:config no_auto_abbrev);<br></div><div>+<br></div><div>+my $quiet= =3D 0;<br></div><div>+my $tree =3D 1;<br></div><div>+my $chk_signoff =3D= 1;<br></div><div>+my $chk_patch =3D undef;<br></div><div>+my $chk_branc= h =3D undef;<br></div><div>+my $tst_only;<br></div><div>+my $emacs =3D 0= ;<br></div><div>+my $terse =3D 0;<br></div><div>+my $file =3D undef;<br>= </div><div>+my $color =3D "auto";<br></div><div>+my $no_warnings =3D 0;<= br></div><div>+my $summary =3D 1;<br></div><div>+my $mailback =3D 0;<br>= </div><div>+my $summary_file =3D 0;<br></div><div>+my $root;<br></div><d= iv>+my %debug;<br></div><div>+my $help =3D 0;<br></div><div>+<br></div><= div>+sub help {<br></div><div>+ my ($exitcode) =3D @_;<br></div><div>+<b= r></div><div>+ print << "EOM";<br></div><div>+Usage:<br></div><div= >+<br></div><div>+ $P [OPTION]... [FILE]...<br></div><= div>+ $P [OPTION]... [GIT-REV-LIST]<br></div><div>+<br= ></div><div>+Version: $V<br></div><div>+<br></div><div>+Options:<br></di= v><div>+ -q, --quiet &nbs= p; quiet<br></div><div>+ = --patch &nbs= p; treat FILE as patchfi= le<br></div><div>+ --branch &nb= sp; tr= eat args as GIT revision list<br></div><div>+ --emacs &= nbsp; &= nbsp; emacs compile window format<br></div><div>= + --terse &nb= sp; one line per r= eport<br></div><div>+ -f, --file &nbs= p; treat FIL= E as regular source file<br></div><div>+ --strict  = ;  = ; fail if only warnings are found<br></div><div>+ = ; --no-summary &nbs= p; suppress the per-file summary<br></div><div>+= --mailback &= nbsp; only produce a report in case = of warnings/errors<br></div><div>+ --summary-file  = ; include the file= name in summary<br></div><div>+ --debug KEY=3D[0|1] &nb= sp; turn on/off debugging of KEY, wh= ere KEY is one of<br></div><div>+ &nb= sp; &nb= sp; 'values', 'pos= sible', 'type', and 'attr' (default<br></div><div>+ &nb= sp; &nb= sp; &nb= sp; is all off)<br></div><div>+ --test-only=3DWORD &nbs= p; report only warnings/errors= containing WORD<br></div><div>+ &nbs= p; &nbs= p; literally<br></= div><div>+ --color[=3DWHEN] &nb= sp; Use colors 'always', 'never', or only = when output<br></div><div>+ &nb= sp; &nb= sp; is a terminal ('auto= '). Default is 'auto'.<br></div><div>+ -h, --help, --version = display this help and exit<br></div><div>+<br><= /div><div>+When FILE is - read standard input.<br></div><div>+EOM<br></d= iv><div>+<br></div><div>+ exit($exitcode);<br></div><div>+}<br></div><di= v>+<br></div><div>+# Use at your own risk<br></div><div>+print "\n", MAG= ENTA, "WARNING:", RESET, " This code is highly experimental ... likely i= sn't a great style(9) match yet\n\n";<br></div><div>+<br></div><div>+# P= erl's Getopt::Long allows options to take optional arguments after a spa= ce.<br></div><div>+# Prevent --color by itself from consuming other argu= ments<br></div><div>+foreach (@ARGV) {<br></div><div>+ if ($_ eq "--colo= r" || $_ eq "-color") {<br></div><div>+ $_ =3D "--color=3D$color";<br><= /div><div>+ }<br></div><div>+}<br></div><div>+<br></div><div>+GetOptions= (<br></div><div>+ 'q|quiet+' =3D> \$quiet,<br></div><div>+ 'tree!' =3D= > \$tree,<br></div><div>+ 'signoff!' =3D> \$chk_signoff,<br></div>= <div>+ 'patch!' =3D> \$chk_patch,<br></div><div>+ 'branch!' =3D> \= $chk_branch,<br></div><div>+ 'emacs!' =3D> \$emacs,<br></div><div>+ '= terse!' =3D> \$terse,<br></div><div>+ 'f|file!' =3D> \$file,<br></= div><div>+ 'strict!' =3D> \$no_warnings,<br></div><div>+ 'root=3Ds' =3D= > \$root,<br></div><div>+ 'summary!' =3D> \$summary,<br></div><div= >+ 'mailback!' =3D> \$mailback,<br></div><div>+ 'summary-file!' =3D&g= t; \$summary_file,<br></div><div>+<br></div><div>+ 'debug=3Ds' =3D> \= %debug,<br></div><div>+ 'test-only=3Ds' =3D> \$tst_only,<br></div><di= v>+ 'color=3Ds' =3D> \$color,<br>= </div><div>+ 'no-color' =3D> sub { $col= or =3D 'never'; },<br></div><div>+ 'h|help' =3D> \$help,<br></div><di= v>+ 'version' =3D> \$help<br></div><div>+) or help(1);<br></div><div>= +<br></div><div>+help(0) if ($help);<br></div><div>+<br></div><div>+my $= exit =3D 0;<br></div><div>+<br></div><div>+if ($#ARGV < 0) {<br></div= ><div>+ print "$P: no input files\n";<br></div><div>+ exit(1);<br></div>= <div>+}<br></div><div>+<br></div><div>+if (!defined $chk_branch &&am= p; !defined $chk_patch && !defined $file) {<br></div><div>+ $chk= _branch =3D $ARGV[0] =3D~ /.\.\./ ? 1 : 0;<br></div><div>+ $file =3D $AR= GV[0] =3D~ /$SrcFile/ ? 1 : 0;<br></div><div>+ $chk_patch =3D $chk_branc= h || $file ? 0 : 1;<br></div><div>+} elsif (!defined $chk_branch &&a= mp; !defined $chk_patch) {<br></div><div>+ if ($file) {<br></div><div>+ = $chk_branch =3D $chk_patch =3D 0;<br></div><div>+ } else {<br></div><di= v>+ $chk_branch =3D $ARGV[0] =3D~ /.\.\./ ? 1 : 0;<br></div><div>+ $ch= k_patch =3D $chk_branch ? 0 : 1;<br></div><div>+ }<br></div><div>+} elsi= f (!defined $chk_branch && !defined $file) {<br></div><div>+ if = ($chk_patch) {<br></div><div>+ $chk_branch =3D $file =3D 0;<br></div><d= iv>+ } else {<br></div><div>+ $chk_branch =3D $ARGV[0] =3D~ /.\.\./ ? 1= : 0;<br></div><div>+ $file =3D $chk_branch ? 0 : 1;<br></div><div>+ }<= br></div><div>+} elsif (!defined $chk_patch && !defined $file) {= <br></div><div>+ if ($chk_branch) {<br></div><div>+ $chk_patch =3D $fil= e =3D 0;<br></div><div>+ } else {<br></div><div>+ $file =3D $ARGV[0] =3D= ~ /$SrcFile/ ? 1 : 0;<br></div><div>+ $chk_patch =3D $file ? 0 : 1;<br>= </div><div>+ }<br></div><div>+} elsif (!defined $chk_branch) {<br></div>= <div>+ $chk_branch =3D $chk_patch || $file ? 0 : 1;<br></div><div>+} els= if (!defined $chk_patch) {<br></div><div>+ $chk_patch =3D $chk_branch ||= $file ? 0 : 1;<br></div><div>+} elsif (!defined $file) {<br></div><div>= + $file =3D $chk_patch || $chk_branch ? 0 : 1;<br></div><div>+}<br></div= ><div>+<br></div><div>+if (($chk_patch && $chk_branch) ||<br></d= iv><div>+ ($chk_patch && $file) ||<br></div><d= iv>+ ($chk_branch && $file)) {<br></div><div>+= die "Only one of --file, --branch, --patch is permitted\n";<br></div><d= iv>+}<br></div><div>+if (!$chk_patch && !$chk_branch && = !$file) {<br></div><div>+ die "One of --file, --branch, --patch is requi= red\n";<br></div><div>+}<br></div><div>+<br></div><div>+if ($color =3D~ = /^always$/i) {<br></div><div>+ $color =3D 1;<br></div><div>+} elsif ($co= lor =3D~ /^never$/i) {<br></div><div>+ $color =3D 0;<br></div><div>+} el= sif ($color =3D~ /^auto$/i) {<br></div><div>+ $color =3D (-t STDOUT);<br= ></div><div>+} else {<br></div><div>+ die "Invalid color mode: $color\n"= ;<br></div><div>+}<br></div><div>+<br></div><div>+my $dbg_values =3D 0;<= br></div><div>+my $dbg_possible =3D 0;<br></div><div>+my $dbg_type =3D 0= ;<br></div><div>+my $dbg_attr =3D 0;<br></div><div>+my $dbg_adv_dcs =3D = 0;<br></div><div>+my $dbg_adv_checking =3D 0;<br></div><div>+my $dbg_adv= _apw =3D 0;<br></div><div>+for my $key (keys %debug) {<br></div><div>+ #= # no critic<br></div><div>+ eval "\${dbg_$key} =3D '$debug{$key}';";<br>= </div><div>+ die "$@" if ($@);<br></div><div>+}<br></div><div>+<br></div= ><div>+my $rpt_cleaners =3D 0;<br></div><div>+<br></div><div>+if ($terse= ) {<br></div><div>+ $emacs =3D 1;<br></div><div>+ $quiet++;<br></div><di= v>+}<br></div><div>+<br></div><div>+my $emitted_corrupt =3D 0;<br></div>= <div>+<br></div><div>+our $Ident =3D qr{<br></div><div>+ [A-Za-z_][A-Z= a-z\d_]*<br></div><div>+ (?:\s*\#\#\s*[A-Za-z_][A-Za-z\d_]*)*<br></div= ><div>+ }x;<br></div><div>+our $Storage =3D qr{extern|static|asmlinkage= };<br></div><div>+our $Sparse =3D qr{<br></div><div>+ __force<br></div= ><div>+ }x;<br></div><div>+<br></div><div>+# Notes to $Attribute:<br></= div><div>+our $Attribute =3D qr{<br></div><div>+ const|<br></div><div>= + volatile|<br></div><div>+ QEMU_NORETURN|<br></div><div>+ QEMU_WA= RN_UNUSED_RESULT|<br></div><div>+ QEMU_SENTINEL|<br></div><div>+ QEM= U_PACKED|<br></div><div>+ GCC_FMT_ATTR<br></div><div>+ }x;<br>= </div><div>+our $Modifier;<br></div><div>+our $Inline =3D qr{inline};<br= ></div><div>+our $Member =3D qr{->$Ident|\.$Ident|\[[^]]*\]};<br></di= v><div>+our $Lval =3D qr{$Ident(?:$Member)*};<br></div><div>+<br></div><= div>+our $Constant =3D qr{(?:[0-9]+|0x[0-9a-fA-F]+)[UL]*};<br></div><div= >+our $Assignment =3D qr{(?:\*\=3D|/=3D|%=3D|\+=3D|-=3D|<<=3D|>= >=3D|&=3D|\^=3D|\|=3D|=3D)};<br></div><div>+our $Compare &nb= sp; =3D qr{<=3D|>=3D|=3D=3D|!=3D|<|>};<br></div><div>+= our $Operators =3D qr{<br></div><div>+ <=3D|>=3D|=3D=3D|!=3D|<br= ></div><div>+ =3D>|->|<<|>>|<|>|!|~|<br></div>= <div>+ &&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|%<br></div><di= v>+ }x;<br></div><div>+<br></div><div>+our $NonptrType;<br></div= ><div>+our $Type;<br></div><div>+our $Declare;<br></div><div>+<br></div>= <div>+our $NON_ASCII_UTF8 =3D qr{<br></div><div>+ [\xC2-\xDF][\x80-\xBF]= = # non-overlong 2-byte<br></div><div>+ | \xE0[\xA0-\xB= F][\x80-\xBF] # excluding over= longs<br></div><div>+ | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2} # straig= ht 3-byte<br></div><div>+ | \xED[\x80-\x9F][\x80-\xBF] = # excluding surrogates<br></div><div>+ |&= nbsp; \xF0[\x90-\xBF][\x80-\xBF]{2} # planes 1-3= <br></div><div>+ | [\xF1-\xF3][\x80-\xBF]{3} &nbs= p; # planes 4-15<br></div><div>+ | \xF4[\x= 80-\x8F][\x80-\xBF]{2} # plane 16<br></div><div>= +}x;<br></div><div>+<br></div><div>+our $UTF8 =3D qr{<br></div><div>+ [\= x09\x0A\x0D\x20-\x7E] &nb= sp; # ASCII<br></div><div>+ | $NON_ASCII_UTF8<br= ></div><div>+}x;<br></div><div>+<br></div><div>+# some readers default t= o ISO-8859-1 when showing email source. detect<br></div><div>+# when UTF= -8 is incorrectly interpreted as ISO-8859-1 and reencoded back.<br></div= ><div>+# False positives are possible but very unlikely.<br></div><div>+= our $UTF8_MOJIBAKE =3D qr{<br></div><div>+ \xC3[\x82-\x9F] \xC2[\x80-\xB= F] &nbs= p; # c2-df 80-bf<br></div><div= >+ | \xC3\xA0 \xC2[\xA0-\xBF] \xC2[\x80-\xBF] &nb= sp; # e0 a0-bf 80-bf<br></div><div>+ | \xC3[\xA1-\xAC\= xAE\xAF] (?: \xC2[\x80-\xBF]){2} # e1-ec/ee/ef 80-bf 80-bf<br></di= v><div>+ | \xC3\xAD \xC2[\x80-\x9F] \xC2[\x80-\xBF] &nb= sp; # ed 80-9f 80-bf<br></div><div>+ | \xC3\xB0 = \xC2[\x90-\xBF] (?: \xC2[\x80-\xBF]){2} # f0 90-bf 80-bf 80-bf<br></div>= <div>+ | \xC3[\xB1-\xB3] (?: \xC2[\x80-\xBF]){3} = # f1-f3 80-bf 80-bf 80-bf<br></div><div>+= | \xC3\xB4 \xC2[\x80-\x8F] (?: \xC2[\x80-\xBF]){2} # f4 80-b8 80-bf 80-= bf<br></div><div>+}x;<br></div><div>+<br></div><div>+# There are still s= ome false positives, but this catches most<br></div><div>+# common cases= .<br></div><div>+our $typeTypedefs =3D qr{(?x:<br></div><div>+ &nbs= p; (?![KMGTPE]iB) &= nbsp; &= nbsp; # IEC binary prefix (do not match)<br></di= v><div>+ [A-Z][A-Z\d_]*[a-z][A= -Za-z\d_]* # camelcase<br></div><div>+ &nbs= p; | [A-Z][A-Z\d_]*AIOCB = # all= uppercase<br></div><div>+ | [= A-Z][A-Z\d_]*CPU &n= bsp; # all uppercase<br></div><div>+= | QEMUBH &nb= sp; &nb= sp; # = all uppercase<br></div><div>+)};<br></div><div>+<br></div><div>+our @typ= eList =3D (<br></div><div>+ qr{void},<br></div><div>+ qr{(?:unsigned\s+)= ?char},<br></div><div>+ qr{(?:unsigned\s+)?short},<br></div><div>+ qr{(?= :unsigned\s+)?int},<br></div><div>+ qr{(?:unsigned\s+)?long},<br></div><= div>+ qr{(?:unsigned\s+)?long\s+int},<br></div><div>+ qr{(?:unsigned\s+)= ?long\s+long},<br></div><div>+ qr{(?:unsigned\s+)?long\s+long\s+int},<br= ></div><div>+ qr{unsigned},<br></div><div>+ qr{float},<br></div><div>+ q= r{double},<br></div><div>+ qr{bool},<br></div><div>+ qr{struct\s+$Ident}= ,<br></div><div>+ qr{union\s+$Ident},<br></div><div>+ qr{enum\s+$Ident},= <br></div><div>+ qr{${Ident}_t},<br></div><div>+ qr{${Ident}_handler},<b= r></div><div>+ qr{${Ident}_handler_fn},<br></div><div>+ qr{target_(?:u)?= long},<br></div><div>+ qr{hwaddr},<br></div><div>+);<br></div><div>+<br>= </div><div>+# This can be modified by sub possible. Since it can b= e empty, be careful<br></div><div>+# about regexes that always match, be= cause they can cause infinite loops.<br></div><div>+our @modifierList =3D= (<br></div><div>+);<br></div><div>+<br></div><div>+sub build_types {<br= ></div><div>+ my $all =3D "(?x: \n" . join("|\n ", @typeList= ) . "\n)";<br></div><div>+ if (@modifierList > 0) {<br></div><div>+ = my $mods =3D "(?x: \n" . join("|\n ", @modifierList) . "\n)"= ;<br></div><div>+ $Modifier =3D qr{(?:$Attribute|$Sparse|$mods)};<br></= div><div>+ } else {<br></div><div>+ $Modifier =3D qr{(?:$Attribute|$Spa= rse)};<br></div><div>+ }<br></div><div>+ $NonptrType =3D qr{<br></div><d= iv>+ (?:$Modifier\s+|const\s+)*<br></div><div>+ (?:<br></div><div>+ = (?:typeof|__typeof__)\s*\(\s*\**\s*$Ident\s*\)|<br></div><div>+ (?= :$typeTypedefs\b)|<br></div><div>+ (?:${all}\b)<br></div><div>+ )<b= r></div><div>+ (?:\s+$Modifier|\s+const)*<br></div><div>+ }x;<= br></div><div>+ $Type =3D qr{<br></div><div>+ $NonptrType<br></div><di= v>+ (?:[\s\*]+\s*const|[\s\*]+|(?:\s*\[\s*\])+)?<br></div><div>+ (?:= \s+$Inline|\s+$Modifier)*<br></div><div>+ }x;<br></div><div>+ $D= eclare =3D qr{(?:$Storage\s+)?$Type};<br></div><div>+}<br></div><div>+bu= ild_types();<br></div><div>+<br></div><div>+$chk_signoff =3D 0 if ($file= );<br></div><div>+<br></div><div>+my @rawlines =3D ();<br></div><div>+my= @lines =3D ();<br></div><div>+my $vname;<br></div><div>+if ($chk_branch= ) {<br></div><div>+ my @patches;<br></div><div>+ my %git_commits =3D ();= <br></div><div>+ my $HASH;<br></div><div>+ open($HASH, "-|", "git", "log= ", "--reverse", "--no-merges", "--format=3D%H %s", $ARGV[0]) ||<br></div= ><div>+ die "$P: git log --reverse --no-merges --format=3D'%H %s' $ARGV= [0] failed - $!\n";<br></div><div>+<br></div><div>+ for my $line (<$H= ASH>) {<br></div><div>+ $line =3D~ /^([0-9a-fA-F]{40,40}) (.*)$/;<br= ></div><div>+ next if (!defined($1) || !defined($2));<br></div><div>+ = my $sha1 =3D $1;<br></div><div>+ my $subject =3D $2;<br></div><div>+ p= ush(@patches, $sha1);<br></div><div>+ $git_commits{$sha1} =3D $subject;= <br></div><div>+ }<br></div><div>+<br></div><div>+ close $HASH;<br></div= ><div>+<br></div><div>+ die "$P: no revisions returned for revlist '$ARG= V[0]'\n"<br></div><div>+ unless @patches;<br></div><d= iv>+<br></div><div>+ my $i =3D 1;<br></div><div>+ my $num_patches =3D @p= atches;<br></div><div>+ for my $hash (@patches) {<br></div><div>+ my $F= ILE;<br></div><div>+ open($FILE, '-|', "git", "show", "--patch-with-sta= t", $hash) ||<br></div><div>+ die "$P: git show $hash - $!\n";<br></di= v><div>+ while (<$FILE>) {<br></div><div>+ chomp;<br></div><div= >+ push(@rawlines, $_);<br></div><div>+ }<br></div><div>+ close($FIL= E);<br></div><div>+ $vname =3D substr($hash, 0, 12) . ' (' . $git_commi= ts{$hash} . ')';<br></div><div>+ if ($num_patches > 1 && $qu= iet =3D=3D 0) {<br></div><div>+ my $prefix =3D "$i/$num_patches";<br><= /div><div>+ $prefix =3D BLUE . BOLD . $prefix . RESET if $color;<br></= div><div>+ print "$prefix Checking commit $vname\n";<br></div><div>+ = $vname =3D "Patch $i/$num_patches";<br></div><div>+ } else {<br></div>= <div>+ $vname =3D "Commit " . $vname;<br></div><div>+ }<br></div><div= >+ if (!process($hash)) {<br></div><div>+ $exit =3D 1;<br></div><div>= + print "\n" if ($num_patches > 1 && $quiet =3D=3D 0);<br><= /div><div>+ }<br></div><div>+ @rawlines =3D ();<br></div><div>+ @line= s =3D ();<br></div><div>+ $i++;<br></div><div>+ }<br></div><div>+} else= {<br></div><div>+ for my $filename (@ARGV) {<br></div><div>+ my $FILE;= <br></div><div>+ if ($file) {<br></div><div>+ open($FILE, '-|', "diff= -u /dev/null $filename") ||<br></div><div>+ die "$P: $filename: diff= failed - $!\n";<br></div><div>+ } elsif ($filename eq '-') {<br></div>= <div>+ open($FILE, '<&STDIN');<br></div><div>+ } else {<br></d= iv><div>+ open($FILE, '<', "$filename") ||<br></div><div>+ die "= $P: $filename: open failed - $!\n";<br></div><div>+ }<br></div><div>+ = if ($filename eq '-') {<br></div><div>+ $vname =3D 'Your patch';<br></= div><div>+ } else {<br></div><div>+ $vname =3D $filename;<br></div><d= iv>+ }<br></div><div>+ print "Checking $filename...\n" if @ARGV > 1= && $quiet =3D=3D 0;<br></div><div>+ while (<$FILE>) {<br= ></div><div>+ chomp;<br></div><div>+ push(@rawlines, $_);<br></div><= div>+ }<br></div><div>+ close($FILE);<br></div><div>+ if (!process($f= ilename)) {<br></div><div>+ $exit =3D 1;<br></div><div>+ }<br></div><= div>+ @rawlines =3D ();<br></div><div>+ @lines =3D ();<br></div><div>+= }<br></div><div>+}<br></div><div>+<br></div><div>+exit($exit);<br></div= ><div>+<br></div><div>+sub top_of_kernel_tree {<br></div><div>+ my ($roo= t) =3D @_;<br></div><div>+<br></div><div>+ my @tree_check =3D (<br></div= ><div>+ "Makefile.inc1", "README.md", "sys",<br></div= ><div>+ "usr.sbin"<br></div><div>+ );<br></div><div>+= <br></div><div>+ foreach my $check (@tree_check) {<br></div><div>+ if (= ! -e $root . '/' . $check) {<br></div><div>+ return 0;<br></div><div>+= }<br></div><div>+ }<br></div><div>+ return 1;<br></div><div>+}<br></di= v><div>+<br></div><div>+sub expand_tabs {<br></div><div>+ my ($str) =3D = @_;<br></div><div>+<br></div><div>+ my $res =3D '';<br></div><div>+ my $= n =3D 0;<br></div><div>+ for my $c (split(//, $str)) {<br></div><div>+ = if ($c eq "\t") {<br></div><div>+ $res .=3D ' ';<br></div><div>+ $n+= +;<br></div><div>+ for (; ($n % 8) !=3D 0; $n++) {<br></div><div>+ = $res .=3D ' ';<br></div><div>+ }<br></div><div>+ next;<br></div><div= >+ }<br></div><div>+ $res .=3D $c;<br></div><div>+ $n++;<br></div><di= v>+ }<br></div><div>+<br></div><div>+ return $res;<br></div><div>+}<br><= /div><div>+sub copy_spacing {<br></div><div>+ (my $res =3D shift) =3D~ t= r/\t/ /c;<br></div><div>+ return $res;<br></div><div>+}<br></div><div>+<= br></div><div>+sub line_stats {<br></div><div>+ my ($line) =3D @_;<br></= div><div>+<br></div><div>+ # Drop the diff line leader and expand tabs<b= r></div><div>+ $line =3D~ s/^.//;<br></div><div>+ $line =3D expand_tabs(= $line);<br></div><div>+<br></div><div>+ # Pick the indent from the front= of the line.<br></div><div>+ my ($white) =3D ($line =3D~ /^(\s*)/);<br>= </div><div>+<br></div><div>+ return (length($line), length($white));<br>= </div><div>+}<br></div><div>+<br></div><div>+my $sanitise_quote =3D '';<= br></div><div>+<br></div><div>+sub sanitise_line_reset {<br></div><div>+= my ($in_comment) =3D @_;<br></div><div>+<br></div><div>+ if ($in_commen= t) {<br></div><div>+ $sanitise_quote =3D '*/';<br></div><div>+ } else {= <br></div><div>+ $sanitise_quote =3D '';<br></div><div>+ }<br></div><di= v>+}<br></div><div>+sub sanitise_line {<br></div><div>+ my ($line) =3D @= _;<br></div><div>+<br></div><div>+ my $res =3D '';<br></div><div>+ my $l= =3D '';<br></div><div>+<br></div><div>+ my $qlen =3D 0;<br></div><div>+= my $off =3D 0;<br></div><div>+ my $c;<br></div><div>+<br></div><div>+ #= Always copy over the diff marker.<br></div><div>+ $res =3D substr($line= , 0, 1);<br></div><div>+<br></div><div>+ for ($off =3D 1; $off < leng= th($line); $off++) {<br></div><div>+ $c =3D substr($line, $off, 1);<br>= </div><div>+<br></div><div>+ # Comments we are wacking completely inclu= ding the begin<br></div><div>+ # and end, all to $;.<br></div><div>+ i= f ($sanitise_quote eq '' && substr($line, $off, 2) eq '/*') {<br= ></div><div>+ $sanitise_quote =3D '*/';<br></div><div>+<br></div><div>= + substr($res, $off, 2, "$;$;");<br></div><div>+ $off++;<br></div><d= iv>+ next;<br></div><div>+ }<br></div><div>+ if ($sanitise_quote eq = '*/' && substr($line, $off, 2) eq '*/') {<br></div><div>+ $san= itise_quote =3D '';<br></div><div>+ substr($res, $off, 2, "$;$;");<br>= </div><div>+ $off++;<br></div><div>+ next;<br></div><div>+ }<br></d= iv><div>+ if ($sanitise_quote eq '' && substr($line, $off, 2) e= q '//') {<br></div><div>+ $sanitise_quote =3D '//';<br></div><div>+<br= ></div><div>+ substr($res, $off, 2, $sanitise_quote);<br></div><div>+ = $off++;<br></div><div>+ next;<br></div><div>+ }<br></div><div>+<br>= </div><div>+ # A \ in a string means ignore the next character.<br></di= v><div>+ if (($sanitise_quote eq "'" || $sanitise_quote eq '"') &&a= mp;<br></div><div>+ $c eq "\\") {<br></div><div>+ = substr($res, $off, 2, 'XX');<br></div><div>+ $off++;<br></div><div>+ = next;<br></div><div>+ }<br></div><div>+ # Regular quotes.<br></div><d= iv>+ if ($c eq "'" || $c eq '"') {<br></div><div>+ if ($sanitise_quot= e eq '') {<br></div><div>+ $sanitise_quote =3D $c;<br></div><div>+<br= ></div><div>+ substr($res, $off, 1, $c);<br></div><div>+ next;<br>= </div><div>+ } elsif ($sanitise_quote eq $c) {<br></div><div>+ $san= itise_quote =3D '';<br></div><div>+ }<br></div><div>+ }<br></div><div= >+<br></div><div>+ #print "c<$c> SQ<$sanitise_quote>\n";<br= ></div><div>+ if ($off !=3D 0 && $sanitise_quote eq '*/' &&= amp; $c ne "\t") {<br></div><div>+ substr($res, $off, 1, $;);<br></div= ><div>+ } elsif ($off !=3D 0 && $sanitise_quote eq '//' &&a= mp; $c ne "\t") {<br></div><div>+ substr($res, $off, 1, $;);<br></div>= <div>+ } elsif ($off !=3D 0 && $sanitise_quote && $c ne= "\t") {<br></div><div>+ substr($res, $off, 1, 'X');<br></div><div>+ = } else {<br></div><div>+ substr($res, $off, 1, $c);<br></div><div>+ }= <br></div><div>+ }<br></div><div>+<br></div><div>+ if ($sanitise_quote e= q '//') {<br></div><div>+ $sanitise_quote =3D '';<br></div><div>+ }<br>= </div><div>+<br></div><div>+ # The pathname on a #include may be surroun= ded by '<' and '>'.<br></div><div>+ if ($res =3D~ /^.\s*\#\s*inclu= de\s+\<(.*)\>/) {<br></div><div>+ my $clean =3D 'X' x length($1);= <br></div><div>+ $res =3D~ s@\<.*\>@<$clean>@;<br></div><di= v>+<br></div><div>+ # The whole of a #error is a string.<br></div><div>+= } elsif ($res =3D~ /^.\s*\#\s*(?:error|warning)\s+(.*)\b/) {<br></div><= div>+ my $clean =3D 'X' x length($1);<br></div><div>+ $res =3D~ s@(\#\= s*(?:error|warning)\s+).*@$1$clean@;<br></div><div>+ }<br></div><div>+<b= r></div><div>+ return $res;<br></div><div>+}<br></div><div>+<br></div><d= iv>+sub ctx_statement_block {<br></div><div>+ my ($linenr, $remain, $off= ) =3D @_;<br></div><div>+ my $line =3D $linenr - 1;<br></div><div>+ my $= blk =3D '';<br></div><div>+ my $soff =3D $off;<br></div><div>+ my $coff = =3D $off - 1;<br></div><div>+ my $coff_set =3D 0;<br></div><div>+<br></d= iv><div>+ my $loff =3D 0;<br></div><div>+<br></div><div>+ my $type =3D '= ';<br></div><div>+ my $level =3D 0;<br></div><div>+ my @stack =3D ();<br= ></div><div>+ my $p;<br></div><div>+ my $c;<br></div><div>+ my $len =3D = 0;<br></div><div>+<br></div><div>+ my $remainder;<br></div><div>+ while = (1) {<br></div><div>+ @stack =3D (['', 0]) if ($#stack =3D=3D -1);<br><= /div><div>+<br></div><div>+ #warn "CSB: blk<$blk> remain<$rema= in>\n";<br></div><div>+ # If we are about to drop off the end, pull = in more<br></div><div>+ # context.<br></div><div>+ if ($off >=3D $l= en) {<br></div><div>+ for (; $remain > 0; $line++) {<br></div><div>= + last if (!defined $lines[$line]);<br></div><div>+ next if ($line= s[$line] =3D~ /^-/);<br></div><div>+ $remain--;<br></div><div>+ $l= off =3D $len;<br></div><div>+ $blk .=3D $lines[$line] . "\n";<br></di= v><div>+ $len =3D length($blk);<br></div><div>+ $line++;<br></div>= <div>+ last;<br></div><div>+ }<br></div><div>+ # Bail if there is= no further context.<br></div><div>+ #warn "CSB: blk<$blk> off&l= t;$off> len<$len>\n";<br></div><div>+ if ($off >=3D $len) = {<br></div><div>+ last;<br></div><div>+ }<br></div><div>+ }<br></d= iv><div>+ $p =3D $c;<br></div><div>+ $c =3D substr($blk, $off, 1);<br>= </div><div>+ $remainder =3D substr($blk, $off);<br></div><div>+<br></di= v><div>+ #warn "CSB: c<$c> type<$type> level<$level> = remainder<$remainder> coff_set<$coff_set>\n";<br></div><div>= +<br></div><div>+ # Handle nested #if/#else.<br></div><div>+ if ($rema= inder =3D~ /^#\s*(?:ifndef|ifdef|if)\s/) {<br></div><div>+ push(@stack= , [ $type, $level ]);<br></div><div>+ } elsif ($remainder =3D~ /^#\s*(?= :else|elif)\b/) {<br></div><div>+ ($type, $level) =3D @{$stack[$#stack= - 1]};<br></div><div>+ } elsif ($remainder =3D~ /^#\s*endif\b/) {<br><= /div><div>+ ($type, $level) =3D @{pop(@stack)};<br></div><div>+ }<br>= </div><div>+<br></div><div>+ # Statement ends at the ';' or a close '}'= at the<br></div><div>+ # outermost level.<br></div><div>+ if ($level = =3D=3D 0 && $c eq ';') {<br></div><div>+ last;<br></div><div>+= }<br></div><div>+<br></div><div>+ # An else is really a conditional a= s long as its not else if<br></div><div>+ if ($level =3D=3D 0 &&= ; $coff_set =3D=3D 0 &&<br></div><div>+ (!defined($p) || $p =3D= ~ /(?:\s|\}|\+)/) &&<br></div><div>+ $remainder =3D~ /^(else)= (?:\s|{)/ &&<br></div><div>+ $remainder !~ /^else\s+if\b/) {<= br></div><div>+ $coff =3D $off + length($1) - 1;<br></div><div>+ $co= ff_set =3D 1;<br></div><div>+ #warn "CSB: mark coff<$coff> soff&= lt;$soff> 1<$1>\n";<br></div><div>+ #warn "[" . substr($blk, = $soff, $coff - $soff + 1) . "]\n";<br></div><div>+ }<br></div><div>+<br= ></div><div>+ if (($type eq '' || $type eq '(') && $c eq '(') {= <br></div><div>+ $level++;<br></div><div>+ $type =3D '(';<br></div><= div>+ }<br></div><div>+ if ($type eq '(' && $c eq ')') {<br></= div><div>+ $level--;<br></div><div>+ $type =3D ($level !=3D 0)? '(' = : '';<br></div><div>+<br></div><div>+ if ($level =3D=3D 0 && $= coff < $soff) {<br></div><div>+ $coff =3D $off;<br></div><div>+ = $coff_set =3D 1;<br></div><div>+ #warn "CSB: mark coff<$coff>\= n";<br></div><div>+ }<br></div><div>+ }<br></div><div>+ if (($type e= q '' || $type eq '{') && $c eq '{') {<br></div><div>+ $level++= ;<br></div><div>+ $type =3D '{';<br></div><div>+ }<br></div><div>+ i= f ($type eq '{' && $c eq '}') {<br></div><div>+ $level--;<br><= /div><div>+ $type =3D ($level !=3D 0)? '{' : '';<br></div><div>+<br></= div><div>+ if ($level =3D=3D 0) {<br></div><div>+ if (substr($blk, = $off + 1, 1) eq ';') {<br></div><div>+ $off++;<br></div><div>+ }<= br></div><div>+ last;<br></div><div>+ }<br></div><div>+ }<br></div= ><div>+ $off++;<br></div><div>+ }<br></div><div>+ # We are truly at the= end, so shuffle to the next line.<br></div><div>+ if ($off =3D=3D $len)= {<br></div><div>+ $loff =3D $len + 1;<br></div><div>+ $line++;<br></d= iv><div>+ $remain--;<br></div><div>+ }<br></div><div>+<br></div><div>+ = my $statement =3D substr($blk, $soff, $off - $soff + 1);<br></div><div>+= my $condition =3D substr($blk, $soff, $coff - $soff + 1);<br></div><div= >+<br></div><div>+ #warn "STATEMENT<$statement>\n";<br></div><div>= + #warn "CONDITION<$condition>\n";<br></div><div>+<br></div><div>+= #print "coff<$coff> soff<$off> loff<$loff>\n";<br></d= iv><div>+<br></div><div>+ return ($statement, $condition,<br></div><div>= + $line, $remain + 1, $off - $loff + 1, $level);<br></div><div>+}<br><= /div><div>+<br></div><div>+sub statement_lines {<br></div><div>+ my ($st= mt) =3D @_;<br></div><div>+<br></div><div>+ # Strip the diff line prefix= es and rip blank lines at start and end.<br></div><div>+ $stmt =3D~ s/(^= |\n)./$1/g;<br></div><div>+ $stmt =3D~ s/^\s*//;<br></div><div>+ $stmt =3D= ~ s/\s*$//;<br></div><div>+<br></div><div>+ my @stmt_lines =3D ($stmt =3D= ~ /\n/g);<br></div><div>+<br></div><div>+ return $#stmt_lines + 2;<br></= div><div>+}<br></div><div>+<br></div><div>+sub statement_rawlines {<br><= /div><div>+ my ($stmt) =3D @_;<br></div><div>+<br></div><div>+ my @stmt_= lines =3D ($stmt =3D~ /\n/g);<br></div><div>+<br></div><div>+ return $#s= tmt_lines + 2;<br></div><div>+}<br></div><div>+<br></div><div>+sub state= ment_block_size {<br></div><div>+ my ($stmt) =3D @_;<br></div><div>+<br>= </div><div>+ $stmt =3D~ s/(^|\n)./$1/g;<br></div><div>+ $stmt =3D~ s/^\s= *\{//;<br></div><div>+ $stmt =3D~ s/}\s*$//;<br></div><div>+ $stmt =3D~ = s/^\s*//;<br></div><div>+ $stmt =3D~ s/\s*$//;<br></div><div>+<br></div>= <div>+ my @stmt_lines =3D ($stmt =3D~ /\n/g);<br></div><div>+ my @stmt_s= tatements =3D ($stmt =3D~ /;/g);<br></div><div>+<br></div><div>+ my $stm= t_lines =3D $#stmt_lines + 2;<br></div><div>+ my $stmt_statements =3D $#= stmt_statements + 1;<br></div><div>+<br></div><div>+ if ($stmt_lines >= ; $stmt_statements) {<br></div><div>+ return $stmt_lines;<br></div><div= >+ } else {<br></div><div>+ return $stmt_statements;<br></div><div>+ }<= br></div><div>+}<br></div><div>+<br></div><div>+sub ctx_statement_full {= <br></div><div>+ my ($linenr, $remain, $off) =3D @_;<br></div><div>+ my = ($statement, $condition, $level);<br></div><div>+<br></div><div>+ my (@c= hunks);<br></div><div>+<br></div><div>+ # Grab the first conditional/blo= ck pair.<br></div><div>+ ($statement, $condition, $linenr, $remain, $off= , $level) =3D<br></div><div>+ ctx_statement_block($linenr, $remain, $= off);<br></div><div>+ #print "F: c<$condition> s<$statement>= remain<$remain>\n";<br></div><div>+ push(@chunks, [ $condition, $= statement ]);<br></div><div>+ if (!($remain > 0 && $condition= =3D~ /^\s*(?:\n[+-])?\s*(?:if|else|do)\b/s)) {<br></div><div>+ return = ($level, $linenr, @chunks);<br></div><div>+ }<br></div><div>+<br></div><= div>+ # Pull in the following conditional/block pairs and see if they<br= ></div><div>+ # could continue the statement.<br></div><div>+ for (;;) {= <br></div><div>+ ($statement, $condition, $linenr, $remain, $off, $leve= l) =3D<br></div><div>+ ctx_statement_block($linenr, $remain, $off);<b= r></div><div>+ #print "C: c<$condition> s<$statement> remai= n<$remain>\n";<br></div><div>+ last if (!($remain > 0 &&am= p; $condition =3D~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s));<br></div><div>+= #print "C: push\n";<br></div><div>+ push(@chunks, [ $condition, $stat= ement ]);<br></div><div>+ }<br></div><div>+<br></div><div>+ return ($lev= el, $linenr, @chunks);<br></div><div>+}<br></div><div>+<br></div><div>+s= ub ctx_block_get {<br></div><div>+ my ($linenr, $remain, $outer, $open, = $close, $off) =3D @_;<br></div><div>+ my $line;<br></div><div>+ my $star= t =3D $linenr - 1;<br></div><div>+ my $blk =3D '';<br></div><div>+ my @o= ;<br></div><div>+ my @c;<br></div><div>+ my @res =3D ();<br></div><div>+= <br></div><div>+ my $level =3D 0;<br></div><div>+ my @stack =3D ($level)= ;<br></div><div>+ for ($line =3D $start; $remain > 0; $line++) {<br><= /div><div>+ next if ($rawlines[$line] =3D~ /^-/);<br></div><div>+ $rem= ain--;<br></div><div>+<br></div><div>+ $blk .=3D $rawlines[$line];<br><= /div><div>+<br></div><div>+ # Handle nested #if/#else.<br></div><div>+ = if ($lines[$line] =3D~ /^.\s*#\s*(?:ifndef|ifdef|if)\s/) {<br></div><di= v>+ push(@stack, $level);<br></div><div>+ } elsif ($lines[$line] =3D~= /^.\s*#\s*(?:else|elif)\b/) {<br></div><div>+ $level =3D $stack[$#sta= ck - 1];<br></div><div>+ } elsif ($lines[$line] =3D~ /^.\s*#\s*endif\b/= ) {<br></div><div>+ $level =3D pop(@stack);<br></div><div>+ }<br></di= v><div>+<br></div><div>+ foreach my $c (split(//, $lines[$line])) {<br>= </div><div>+ ##print "C<$c>L<$level><$open$close>O&l= t;$off>\n";<br></div><div>+ if ($off > 0) {<br></div><div>+ $= off--;<br></div><div>+ next;<br></div><div>+ }<br></div><div>+<br><= /div><div>+ if ($c eq $close && $level > 0) {<br></div><div= >+ $level--;<br></div><div>+ last if ($level =3D=3D 0);<br></div><= div>+ } elsif ($c eq $open) {<br></div><div>+ $level++;<br></div><d= iv>+ }<br></div><div>+ }<br></div><div>+<br></div><div>+ if (!$outer= || $level <=3D 1) {<br></div><div>+ push(@res, $rawlines[$line]);<= br></div><div>+ }<br></div><div>+<br></div><div>+ last if ($level =3D=3D= 0);<br></div><div>+ }<br></div><div>+<br></div><div>+ return ($level, @= res);<br></div><div>+}<br></div><div>+sub ctx_block_outer {<br></div><di= v>+ my ($linenr, $remain) =3D @_;<br></div><div>+<br></div><div>+ my ($l= evel, @r) =3D ctx_block_get($linenr, $remain, 1, '{', '}', 0);<br></div>= <div>+ return @r;<br></div><div>+}<br></div><div>+sub ctx_block {<br></d= iv><div>+ my ($linenr, $remain) =3D @_;<br></div><div>+<br></div><div>+ = my ($level, @r) =3D ctx_block_get($linenr, $remain, 0, '{', '}', 0);<br>= </div><div>+ return @r;<br></div><div>+}<br></div><div>+sub ctx_statemen= t {<br></div><div>+ my ($linenr, $remain, $off) =3D @_;<br></div><div>+<= br></div><div>+ my ($level, @r) =3D ctx_block_get($linenr, $remain, 0, '= (', ')', $off);<br></div><div>+ return @r;<br></div><div>+}<br></div><di= v>+sub ctx_block_level {<br></div><div>+ my ($linenr, $remain) =3D @_;<b= r></div><div>+<br></div><div>+ return ctx_block_get($linenr, $remain, 0,= '{', '}', 0);<br></div><div>+}<br></div><div>+sub ctx_statement_level {= <br></div><div>+ my ($linenr, $remain, $off) =3D @_;<br></div><div>+<br>= </div><div>+ return ctx_block_get($linenr, $remain, 0, '(', ')', $off);<= br></div><div>+}<br></div><div>+<br></div><div>+sub ctx_locate_comment {= <br></div><div>+ my ($first_line, $end_line) =3D @_;<br></div><div>+<br>= </div><div>+ # Catch a comment on the end of the line itself.<br></div><= div>+ my ($current_comment) =3D ($rawlines[$end_line - 1] =3D~ m@.*(/\*.= *\*/)\s*(?:\\\s*)?$@);<br></div><div>+ return $current_comment if (defin= ed $current_comment);<br></div><div>+<br></div><div>+ # Look through the= context and try and figure out if there is a<br></div><div>+ # comment.= <br></div><div>+ my $in_comment =3D 0;<br></div><div>+ $current_comment = =3D '';<br></div><div>+ for (my $linenr =3D $first_line; $linenr < $e= nd_line; $linenr++) {<br></div><div>+ my $line =3D $rawlines[$linenr - = 1];<br></div><div>+ #warn " &n= bsp; $line\n";<br></div><div>+ if ($linenr =3D=3D $first_li= ne and $line =3D~ m@^.\s*\*@) {<br></div><div>+ $in_comment =3D 1;<br>= </div><div>+ }<br></div><div>+ if ($line =3D~ m@/\*@) {<br></div><div>= + $in_comment =3D 1;<br></div><div>+ }<br></div><div>+ if (!$in_comm= ent && $current_comment ne '') {<br></div><div>+ $current_comm= ent =3D '';<br></div><div>+ }<br></div><div>+ $current_comment .=3D $l= ine . "\n" if ($in_comment);<br></div><div>+ if ($line =3D~ m@\*/@) {<b= r></div><div>+ $in_comment =3D 0;<br></div><div>+ }<br></div><div>+ }= <br></div><div>+<br></div><div>+ chomp($current_comment);<br></div><div>= + return($current_comment);<br></div><div>+}<br></div><div>+sub ctx_has_= comment {<br></div><div>+ my ($first_line, $end_line) =3D @_;<br></div><= div>+ my $cmt =3D ctx_locate_comment($first_line, $end_line);<br></div><= div>+<br></div><div>+ ##print "LINE: $rawlines[$end_line - 1 ]\n";<br></= div><div>+ ##print "CMMT: $cmt\n";<br></div><div>+<br></div><div>+ retur= n ($cmt ne '');<br></div><div>+}<br></div><div>+<br></div><div>+sub raw_= line {<br></div><div>+ my ($linenr, $cnt) =3D @_;<br></div><div>+<br></d= iv><div>+ my $offset =3D $linenr - 1;<br></div><div>+ $cnt++;<br></div><= div>+<br></div><div>+ my $line;<br></div><div>+ while ($cnt) {<br></div>= <div>+ $line =3D $rawlines[$offset++];<br></div><div>+ next if (define= d($line) && $line =3D~ /^-/);<br></div><div>+ $cnt--;<br></div>= <div>+ }<br></div><div>+<br></div><div>+ return $line;<br></div><div>+}<= br></div><div>+<br></div><div>+sub cat_vet {<br></div><div>+ my ($vet) =3D= @_;<br></div><div>+ my ($res, $coded);<br></div><div>+<br></div><div>+ = $res =3D '';<br></div><div>+ while ($vet =3D~ /([^[:cntrl:]]*)([[:cntrl:= ]]|$)/g) {<br></div><div>+ $res .=3D $1;<br></div><div>+ if ($2 ne '')= {<br></div><div>+ $coded =3D sprintf("^%c", unpack('C', $2) + 64);<br= ></div><div>+ $res .=3D $coded;<br></div><div>+ }<br></div><div>+ }<b= r></div><div>+ $res =3D~ s/$/\$/;<br></div><div>+<br></div><div>+ return= $res;<br></div><div>+}<br></div><div>+<br></div><div>+my $av_preprocess= or =3D 0;<br></div><div>+my $av_pending;<br></div><div>+my @av_paren_typ= e;<br></div><div>+my $av_pend_colon;<br></div><div>+<br></div><div>+sub = annotate_reset {<br></div><div>+ $av_preprocessor =3D 0;<br></div><div>+= $av_pending =3D '_';<br></div><div>+ @av_paren_type =3D ('E');<br></div= ><div>+ $av_pend_colon =3D 'O';<br></div><div>+}<br></div><div>+<br></di= v><div>+sub annotate_values {<br></div><div>+ my ($stream, $type) =3D @_= ;<br></div><div>+<br></div><div>+ my $res;<br></div><div>+ my $var =3D '= _' x length($stream);<br></div><div>+ my $cur =3D $stream;<br></div><div= >+<br></div><div>+ print "$stream\n" if ($dbg_values > 1);<br></div><= div>+<br></div><div>+ while (length($cur)) {<br></div><div>+ @av_paren_= type =3D ('E') if ($#av_paren_type < 0);<br></div><div>+ print " <= ;" . join('', @av_paren_type) .<br></div><div>+ "> <$type> &= lt;$av_pending>" if ($dbg_values > 1);<br></div><div>+ if ($cur =3D= ~ /^(\s+)/o) {<br></div><div>+ print "WS($1)\n" if ($dbg_values > 1= );<br></div><div>+ if ($1 =3D~ /\n/ && $av_preprocessor) {<br>= </div><div>+ $type =3D pop(@av_paren_type);<br></div><div>+ $av_pr= eprocessor =3D 0;<br></div><div>+ }<br></div><div>+<br></div><div>+ }= elsif ($cur =3D~ /^(\(\s*$Type\s*)\)/ && $av_pending eq '_') {<= br></div><div>+ print "CAST($1)\n" if ($dbg_values > 1);<br></div><= div>+ push(@av_paren_type, $type);<br></div><div>+ $type =3D 'C';<br= ></div><div>+<br></div><div>+ } elsif ($cur =3D~ /^($Type)\s*(?:$Ident|= ,|\)|\(|\s*$)/) {<br></div><div>+ print "DECLARE($1)\n" if ($dbg_value= s > 1);<br></div><div>+ $type =3D 'T';<br></div><div>+<br></div><di= v>+ } elsif ($cur =3D~ /^($Modifier)\s*/) {<br></div><div>+ print "MO= DIFIER($1)\n" if ($dbg_values > 1);<br></div><div>+ $type =3D 'T';<= br></div><div>+<br></div><div>+ } elsif ($cur =3D~ /^(\#\s*define\s*$Id= ent)(\(?)/o) {<br></div><div>+ print "DEFINE($1,$2)\n" if ($dbg_values= > 1);<br></div><div>*** 1791 LINES SKIPPED ***<br></div><div><br></d= iv></blockquote><div><br></div></body></html> --d2b24846419d49c4ab1b06d629e431e9--
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?5b9c31d2-4aaf-4822-b405-cae57164f314>