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>
index | next in thread | previous in thread | raw e-mail
[-- Attachment #1 --] 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 *** > [-- Attachment #2 --] <!DOCTYPE html><html><head><title></title><style type="text/css">p.MsoNormal,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><blockquote type="cite" id="qt" style=""><div>The branch main has been updated by imp:<br></div><div><br></div><div>URL: <a href="https://cgit.FreeBSD.org/src/commit/?id=3a3c9242739efb0c76587ffbaa54c5d10b2cbcb4">https://cgit.FreeBSD.org/src/commit/?id=3a3c9242739efb0c76587ffbaa54c5d10b2cbcb4</a><br></div><div><br></div><div>commit 3a3c9242739efb0c76587ffbaa54c5d10b2cbcb4<br></div><div>Author: Warner Losh <<a href="mailto:imp@FreeBSD.org">imp@FreeBSD.org</a>><br></div><div>AuthorDate: 2023-03-14 21:28:05 +0000<br></div><div>Commit: Warner Losh <<a href="mailto:imp@FreeBSD.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 code 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 might be style(9) violations. It's experimental, since I<br></div><div> heavily hacked on the qemu version to get it to not complain (much)<br></div><div> about iconic code in the tree. At the moment, it's use should be<br></div><div> considered 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 it 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><div><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 000000000000..5aec3819bf7c<br></div><div>--- /dev/null<br></div><div>+++ b/tools/build/checkstyle9.pl<br></div><div>@@ -0,0 +1,2748 @@<br></div><div>+#!/usr/bin/env perl<br></div><div>+# (c) 2001, Dave Jones. (the file handling bit)<br></div><div>+# (c) 2005, Joel Schopp <<a href="mailto:jschopp@austin.ibm.com">jschopp@austin.ibm.com</a>> (the ugly bit)<br></div><div>+# (c) 2007,2008, Andy Whitcroft <<a href="mailto:apw@uk.ibm.com">apw@uk.ibm.com</a>> (new conditions, test suite)<br></div><div>+# (c) 2008-2010 Andy Whitcroft <<a href="mailto:apw@canonical.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>+use strict;<br></div><div>+use warnings;<br></div><div>+use Term::ANSIColor qw(:constants);<br></div><div>+<br></div><div>+my $P = $0;<br></div><div>+$P =~ s@.*/@@g;<br></div><div>+<br></div><div>+our $SrcFile = qr{\.(?:h|c|cpp|s|S|pl|py|sh)$};<br></div><div>+<br></div><div>+my $V = '0.31';<br></div><div>+<br></div><div>+use Getopt::Long qw(:config no_auto_abbrev);<br></div><div>+<br></div><div>+my $quiet = 0;<br></div><div>+my $tree = 1;<br></div><div>+my $chk_signoff = 1;<br></div><div>+my $chk_patch = undef;<br></div><div>+my $chk_branch = undef;<br></div><div>+my $tst_only;<br></div><div>+my $emacs = 0;<br></div><div>+my $terse = 0;<br></div><div>+my $file = undef;<br></div><div>+my $color = "auto";<br></div><div>+my $no_warnings = 0;<br></div><div>+my $summary = 1;<br></div><div>+my $mailback = 0;<br></div><div>+my $summary_file = 0;<br></div><div>+my $root;<br></div><div>+my %debug;<br></div><div>+my $help = 0;<br></div><div>+<br></div><div>+sub help {<br></div><div>+ my ($exitcode) = @_;<br></div><div>+<br></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></div><div>+ -q, --quiet quiet<br></div><div>+ --patch treat FILE as patchfile<br></div><div>+ --branch treat args as GIT revision list<br></div><div>+ --emacs emacs compile window format<br></div><div>+ --terse one line per report<br></div><div>+ -f, --file treat FILE as regular source file<br></div><div>+ --strict fail if only warnings are found<br></div><div>+ --no-summary suppress the per-file summary<br></div><div>+ --mailback only produce a report in case of warnings/errors<br></div><div>+ --summary-file include the filename in summary<br></div><div>+ --debug KEY=[0|1] turn on/off debugging of KEY, where KEY is one of<br></div><div>+ 'values', 'possible', 'type', and 'attr' (default<br></div><div>+ is all off)<br></div><div>+ --test-only=WORD report only warnings/errors containing WORD<br></div><div>+ literally<br></div><div>+ --color[=WHEN] Use colors 'always', 'never', or only when output<br></div><div>+ 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></div><div>+<br></div><div>+ exit($exitcode);<br></div><div>+}<br></div><div>+<br></div><div>+# Use at your own risk<br></div><div>+print "\n", MAGENTA, "WARNING:", RESET, " This code is highly experimental ... likely isn't a great style(9) match yet\n\n";<br></div><div>+<br></div><div>+# Perl's Getopt::Long allows options to take optional arguments after a space.<br></div><div>+# Prevent --color by itself from consuming other arguments<br></div><div>+foreach (@ARGV) {<br></div><div>+ if ($_ eq "--color" || $_ eq "-color") {<br></div><div>+ $_ = "--color=$color";<br></div><div>+ }<br></div><div>+}<br></div><div>+<br></div><div>+GetOptions(<br></div><div>+ 'q|quiet+' => \$quiet,<br></div><div>+ 'tree!' => \$tree,<br></div><div>+ 'signoff!' => \$chk_signoff,<br></div><div>+ 'patch!' => \$chk_patch,<br></div><div>+ 'branch!' => \$chk_branch,<br></div><div>+ 'emacs!' => \$emacs,<br></div><div>+ 'terse!' => \$terse,<br></div><div>+ 'f|file!' => \$file,<br></div><div>+ 'strict!' => \$no_warnings,<br></div><div>+ 'root=s' => \$root,<br></div><div>+ 'summary!' => \$summary,<br></div><div>+ 'mailback!' => \$mailback,<br></div><div>+ 'summary-file!' => \$summary_file,<br></div><div>+<br></div><div>+ 'debug=s' => \%debug,<br></div><div>+ 'test-only=s' => \$tst_only,<br></div><div>+ 'color=s' => \$color,<br></div><div>+ 'no-color' => sub { $color = 'never'; },<br></div><div>+ 'h|help' => \$help,<br></div><div>+ 'version' => \$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 = 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 && !defined $chk_patch && !defined $file) {<br></div><div>+ $chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0;<br></div><div>+ $file = $ARGV[0] =~ /$SrcFile/ ? 1 : 0;<br></div><div>+ $chk_patch = $chk_branch || $file ? 0 : 1;<br></div><div>+} elsif (!defined $chk_branch && !defined $chk_patch) {<br></div><div>+ if ($file) {<br></div><div>+ $chk_branch = $chk_patch = 0;<br></div><div>+ } else {<br></div><div>+ $chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0;<br></div><div>+ $chk_patch = $chk_branch ? 0 : 1;<br></div><div>+ }<br></div><div>+} elsif (!defined $chk_branch && !defined $file) {<br></div><div>+ if ($chk_patch) {<br></div><div>+ $chk_branch = $file = 0;<br></div><div>+ } else {<br></div><div>+ $chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0;<br></div><div>+ $file = $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 = $file = 0;<br></div><div>+ } else {<br></div><div>+ $file = $ARGV[0] =~ /$SrcFile/ ? 1 : 0;<br></div><div>+ $chk_patch = $file ? 0 : 1;<br></div><div>+ }<br></div><div>+} elsif (!defined $chk_branch) {<br></div><div>+ $chk_branch = $chk_patch || $file ? 0 : 1;<br></div><div>+} elsif (!defined $chk_patch) {<br></div><div>+ $chk_patch = $chk_branch || $file ? 0 : 1;<br></div><div>+} elsif (!defined $file) {<br></div><div>+ $file = $chk_patch || $chk_branch ? 0 : 1;<br></div><div>+}<br></div><div>+<br></div><div>+if (($chk_patch && $chk_branch) ||<br></div><div>+ ($chk_patch && $file) ||<br></div><div>+ ($chk_branch && $file)) {<br></div><div>+ die "Only one of --file, --branch, --patch is permitted\n";<br></div><div>+}<br></div><div>+if (!$chk_patch && !$chk_branch && !$file) {<br></div><div>+ die "One of --file, --branch, --patch is required\n";<br></div><div>+}<br></div><div>+<br></div><div>+if ($color =~ /^always$/i) {<br></div><div>+ $color = 1;<br></div><div>+} elsif ($color =~ /^never$/i) {<br></div><div>+ $color = 0;<br></div><div>+} elsif ($color =~ /^auto$/i) {<br></div><div>+ $color = (-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 = 0;<br></div><div>+my $dbg_possible = 0;<br></div><div>+my $dbg_type = 0;<br></div><div>+my $dbg_attr = 0;<br></div><div>+my $dbg_adv_dcs = 0;<br></div><div>+my $dbg_adv_checking = 0;<br></div><div>+my $dbg_adv_apw = 0;<br></div><div>+for my $key (keys %debug) {<br></div><div>+ ## no critic<br></div><div>+ eval "\${dbg_$key} = '$debug{$key}';";<br></div><div>+ die "$@" if ($@);<br></div><div>+}<br></div><div>+<br></div><div>+my $rpt_cleaners = 0;<br></div><div>+<br></div><div>+if ($terse) {<br></div><div>+ $emacs = 1;<br></div><div>+ $quiet++;<br></div><div>+}<br></div><div>+<br></div><div>+my $emitted_corrupt = 0;<br></div><div>+<br></div><div>+our $Ident = qr{<br></div><div>+ [A-Za-z_][A-Za-z\d_]*<br></div><div>+ (?:\s*\#\#\s*[A-Za-z_][A-Za-z\d_]*)*<br></div><div>+ }x;<br></div><div>+our $Storage = qr{extern|static|asmlinkage};<br></div><div>+our $Sparse = qr{<br></div><div>+ __force<br></div><div>+ }x;<br></div><div>+<br></div><div>+# Notes to $Attribute:<br></div><div>+our $Attribute = qr{<br></div><div>+ const|<br></div><div>+ volatile|<br></div><div>+ QEMU_NORETURN|<br></div><div>+ QEMU_WARN_UNUSED_RESULT|<br></div><div>+ QEMU_SENTINEL|<br></div><div>+ QEMU_PACKED|<br></div><div>+ GCC_FMT_ATTR<br></div><div>+ }x;<br></div><div>+our $Modifier;<br></div><div>+our $Inline = qr{inline};<br></div><div>+our $Member = qr{->$Ident|\.$Ident|\[[^]]*\]};<br></div><div>+our $Lval = qr{$Ident(?:$Member)*};<br></div><div>+<br></div><div>+our $Constant = qr{(?:[0-9]+|0x[0-9a-fA-F]+)[UL]*};<br></div><div>+our $Assignment = qr{(?:\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=)};<br></div><div>+our $Compare = qr{<=|>=|==|!=|<|>};<br></div><div>+our $Operators = qr{<br></div><div>+ <=|>=|==|!=|<br></div><div>+ =>|->|<<|>>|<|>|!|~|<br></div><div>+ &&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|%<br></div><div>+ }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 = qr{<br></div><div>+ [\xC2-\xDF][\x80-\xBF] # non-overlong 2-byte<br></div><div>+ | \xE0[\xA0-\xBF][\x80-\xBF] # excluding overlongs<br></div><div>+ | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2} # straight 3-byte<br></div><div>+ | \xED[\x80-\x9F][\x80-\xBF] # excluding surrogates<br></div><div>+ | \xF0[\x90-\xBF][\x80-\xBF]{2} # planes 1-3<br></div><div>+ | [\xF1-\xF3][\x80-\xBF]{3} # planes 4-15<br></div><div>+ | \xF4[\x80-\x8F][\x80-\xBF]{2} # plane 16<br></div><div>+}x;<br></div><div>+<br></div><div>+our $UTF8 = qr{<br></div><div>+ [\x09\x0A\x0D\x20-\x7E] # ASCII<br></div><div>+ | $NON_ASCII_UTF8<br></div><div>+}x;<br></div><div>+<br></div><div>+# some readers default to 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 = qr{<br></div><div>+ \xC3[\x82-\x9F] \xC2[\x80-\xBF] # c2-df 80-bf<br></div><div>+ | \xC3\xA0 \xC2[\xA0-\xBF] \xC2[\x80-\xBF] # 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></div><div>+ | \xC3\xAD \xC2[\x80-\x9F] \xC2[\x80-\xBF] # 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 some false positives, but this catches most<br></div><div>+# common cases.<br></div><div>+our $typeTypedefs = qr{(?x:<br></div><div>+ (?![KMGTPE]iB) # IEC binary prefix (do not match)<br></div><div>+ [A-Z][A-Z\d_]*[a-z][A-Za-z\d_]* # camelcase<br></div><div>+ | [A-Z][A-Z\d_]*AIOCB # all uppercase<br></div><div>+ | [A-Z][A-Z\d_]*CPU # all uppercase<br></div><div>+ | QEMUBH # all uppercase<br></div><div>+)};<br></div><div>+<br></div><div>+our @typeList = (<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>+ qr{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},<br></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 be empty, be careful<br></div><div>+# about regexes that always match, because they can cause infinite loops.<br></div><div>+our @modifierList = (<br></div><div>+);<br></div><div>+<br></div><div>+sub build_types {<br></div><div>+ my $all = "(?x: \n" . join("|\n ", @typeList) . "\n)";<br></div><div>+ if (@modifierList > 0) {<br></div><div>+ my $mods = "(?x: \n" . join("|\n ", @modifierList) . "\n)";<br></div><div>+ $Modifier = qr{(?:$Attribute|$Sparse|$mods)};<br></div><div>+ } else {<br></div><div>+ $Modifier = qr{(?:$Attribute|$Sparse)};<br></div><div>+ }<br></div><div>+ $NonptrType = qr{<br></div><div>+ (?:$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>+ )<br></div><div>+ (?:\s+$Modifier|\s+const)*<br></div><div>+ }x;<br></div><div>+ $Type = qr{<br></div><div>+ $NonptrType<br></div><div>+ (?:[\s\*]+\s*const|[\s\*]+|(?:\s*\[\s*\])+)?<br></div><div>+ (?:\s+$Inline|\s+$Modifier)*<br></div><div>+ }x;<br></div><div>+ $Declare = qr{(?:$Storage\s+)?$Type};<br></div><div>+}<br></div><div>+build_types();<br></div><div>+<br></div><div>+$chk_signoff = 0 if ($file);<br></div><div>+<br></div><div>+my @rawlines = ();<br></div><div>+my @lines = ();<br></div><div>+my $vname;<br></div><div>+if ($chk_branch) {<br></div><div>+ my @patches;<br></div><div>+ my %git_commits = ();<br></div><div>+ my $HASH;<br></div><div>+ open($HASH, "-|", "git", "log", "--reverse", "--no-merges", "--format=%H %s", $ARGV[0]) ||<br></div><div>+ die "$P: git log --reverse --no-merges --format='%H %s' $ARGV[0] failed - $!\n";<br></div><div>+<br></div><div>+ for my $line (<$HASH>) {<br></div><div>+ $line =~ /^([0-9a-fA-F]{40,40}) (.*)$/;<br></div><div>+ next if (!defined($1) || !defined($2));<br></div><div>+ my $sha1 = $1;<br></div><div>+ my $subject = $2;<br></div><div>+ push(@patches, $sha1);<br></div><div>+ $git_commits{$sha1} = $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 '$ARGV[0]'\n"<br></div><div>+ unless @patches;<br></div><div>+<br></div><div>+ my $i = 1;<br></div><div>+ my $num_patches = @patches;<br></div><div>+ for my $hash (@patches) {<br></div><div>+ my $FILE;<br></div><div>+ open($FILE, '-|', "git", "show", "--patch-with-stat", $hash) ||<br></div><div>+ die "$P: git show $hash - $!\n";<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>+ $vname = substr($hash, 0, 12) . ' (' . $git_commits{$hash} . ')';<br></div><div>+ if ($num_patches > 1 && $quiet == 0) {<br></div><div>+ my $prefix = "$i/$num_patches";<br></div><div>+ $prefix = BLUE . BOLD . $prefix . RESET if $color;<br></div><div>+ print "$prefix Checking commit $vname\n";<br></div><div>+ $vname = "Patch $i/$num_patches";<br></div><div>+ } else {<br></div><div>+ $vname = "Commit " . $vname;<br></div><div>+ }<br></div><div>+ if (!process($hash)) {<br></div><div>+ $exit = 1;<br></div><div>+ print "\n" if ($num_patches > 1 && $quiet == 0);<br></div><div>+ }<br></div><div>+ @rawlines = ();<br></div><div>+ @lines = ();<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></div><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 = 'Your patch';<br></div><div>+ } else {<br></div><div>+ $vname = $filename;<br></div><div>+ }<br></div><div>+ print "Checking $filename...\n" if @ARGV > 1 && $quiet == 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($filename)) {<br></div><div>+ $exit = 1;<br></div><div>+ }<br></div><div>+ @rawlines = ();<br></div><div>+ @lines = ();<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 ($root) = @_;<br></div><div>+<br></div><div>+ my @tree_check = (<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></div><div>+<br></div><div>+sub expand_tabs {<br></div><div>+ my ($str) = @_;<br></div><div>+<br></div><div>+ my $res = '';<br></div><div>+ my $n = 0;<br></div><div>+ for my $c (split(//, $str)) {<br></div><div>+ if ($c eq "\t") {<br></div><div>+ $res .= ' ';<br></div><div>+ $n++;<br></div><div>+ for (; ($n % 8) != 0; $n++) {<br></div><div>+ $res .= ' ';<br></div><div>+ }<br></div><div>+ next;<br></div><div>+ }<br></div><div>+ $res .= $c;<br></div><div>+ $n++;<br></div><div>+ }<br></div><div>+<br></div><div>+ return $res;<br></div><div>+}<br></div><div>+sub copy_spacing {<br></div><div>+ (my $res = shift) =~ tr/\t/ /c;<br></div><div>+ return $res;<br></div><div>+}<br></div><div>+<br></div><div>+sub line_stats {<br></div><div>+ my ($line) = @_;<br></div><div>+<br></div><div>+ # Drop the diff line leader and expand tabs<br></div><div>+ $line =~ s/^.//;<br></div><div>+ $line = expand_tabs($line);<br></div><div>+<br></div><div>+ # Pick the indent from the front of the line.<br></div><div>+ my ($white) = ($line =~ /^(\s*)/);<br></div><div>+<br></div><div>+ return (length($line), length($white));<br></div><div>+}<br></div><div>+<br></div><div>+my $sanitise_quote = '';<br></div><div>+<br></div><div>+sub sanitise_line_reset {<br></div><div>+ my ($in_comment) = @_;<br></div><div>+<br></div><div>+ if ($in_comment) {<br></div><div>+ $sanitise_quote = '*/';<br></div><div>+ } else {<br></div><div>+ $sanitise_quote = '';<br></div><div>+ }<br></div><div>+}<br></div><div>+sub sanitise_line {<br></div><div>+ my ($line) = @_;<br></div><div>+<br></div><div>+ my $res = '';<br></div><div>+ my $l = '';<br></div><div>+<br></div><div>+ my $qlen = 0;<br></div><div>+ my $off = 0;<br></div><div>+ my $c;<br></div><div>+<br></div><div>+ # Always copy over the diff marker.<br></div><div>+ $res = substr($line, 0, 1);<br></div><div>+<br></div><div>+ for ($off = 1; $off < length($line); $off++) {<br></div><div>+ $c = substr($line, $off, 1);<br></div><div>+<br></div><div>+ # Comments we are wacking completely including the begin<br></div><div>+ # and end, all to $;.<br></div><div>+ if ($sanitise_quote eq '' && substr($line, $off, 2) eq '/*') {<br></div><div>+ $sanitise_quote = '*/';<br></div><div>+<br></div><div>+ substr($res, $off, 2, "$;$;");<br></div><div>+ $off++;<br></div><div>+ next;<br></div><div>+ }<br></div><div>+ if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') {<br></div><div>+ $sanitise_quote = '';<br></div><div>+ substr($res, $off, 2, "$;$;");<br></div><div>+ $off++;<br></div><div>+ next;<br></div><div>+ }<br></div><div>+ if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') {<br></div><div>+ $sanitise_quote = '//';<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></div><div>+ if (($sanitise_quote eq "'" || $sanitise_quote eq '"') &&<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><div>+ if ($c eq "'" || $c eq '"') {<br></div><div>+ if ($sanitise_quote eq '') {<br></div><div>+ $sanitise_quote = $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>+ $sanitise_quote = '';<br></div><div>+ }<br></div><div>+ }<br></div><div>+<br></div><div>+ #print "c<$c> SQ<$sanitise_quote>\n";<br></div><div>+ if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") {<br></div><div>+ substr($res, $off, 1, $;);<br></div><div>+ } elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") {<br></div><div>+ substr($res, $off, 1, $;);<br></div><div>+ } elsif ($off != 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 eq '//') {<br></div><div>+ $sanitise_quote = '';<br></div><div>+ }<br></div><div>+<br></div><div>+ # The pathname on a #include may be surrounded by '<' and '>'.<br></div><div>+ if ($res =~ /^.\s*\#\s*include\s+\<(.*)\>/) {<br></div><div>+ my $clean = 'X' x length($1);<br></div><div>+ $res =~ s@\<.*\>@<$clean>@;<br></div><div>+<br></div><div>+ # The whole of a #error is a string.<br></div><div>+ } elsif ($res =~ /^.\s*\#\s*(?:error|warning)\s+(.*)\b/) {<br></div><div>+ my $clean = 'X' x length($1);<br></div><div>+ $res =~ s@(\#\s*(?:error|warning)\s+).*@$1$clean@;<br></div><div>+ }<br></div><div>+<br></div><div>+ return $res;<br></div><div>+}<br></div><div>+<br></div><div>+sub ctx_statement_block {<br></div><div>+ my ($linenr, $remain, $off) = @_;<br></div><div>+ my $line = $linenr - 1;<br></div><div>+ my $blk = '';<br></div><div>+ my $soff = $off;<br></div><div>+ my $coff = $off - 1;<br></div><div>+ my $coff_set = 0;<br></div><div>+<br></div><div>+ my $loff = 0;<br></div><div>+<br></div><div>+ my $type = '';<br></div><div>+ my $level = 0;<br></div><div>+ my @stack = ();<br></div><div>+ my $p;<br></div><div>+ my $c;<br></div><div>+ my $len = 0;<br></div><div>+<br></div><div>+ my $remainder;<br></div><div>+ while (1) {<br></div><div>+ @stack = (['', 0]) if ($#stack == -1);<br></div><div>+<br></div><div>+ #warn "CSB: blk<$blk> remain<$remain>\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 >= $len) {<br></div><div>+ for (; $remain > 0; $line++) {<br></div><div>+ last if (!defined $lines[$line]);<br></div><div>+ next if ($lines[$line] =~ /^-/);<br></div><div>+ $remain--;<br></div><div>+ $loff = $len;<br></div><div>+ $blk .= $lines[$line] . "\n";<br></div><div>+ $len = 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<$off> len<$len>\n";<br></div><div>+ if ($off >= $len) {<br></div><div>+ last;<br></div><div>+ }<br></div><div>+ }<br></div><div>+ $p = $c;<br></div><div>+ $c = substr($blk, $off, 1);<br></div><div>+ $remainder = substr($blk, $off);<br></div><div>+<br></div><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 ($remainder =~ /^#\s*(?:ifndef|ifdef|if)\s/) {<br></div><div>+ push(@stack, [ $type, $level ]);<br></div><div>+ } elsif ($remainder =~ /^#\s*(?:else|elif)\b/) {<br></div><div>+ ($type, $level) = @{$stack[$#stack - 1]};<br></div><div>+ } elsif ($remainder =~ /^#\s*endif\b/) {<br></div><div>+ ($type, $level) = @{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 == 0 && $c eq ';') {<br></div><div>+ last;<br></div><div>+ }<br></div><div>+<br></div><div>+ # An else is really a conditional as long as its not else if<br></div><div>+ if ($level == 0 && $coff_set == 0 &&<br></div><div>+ (!defined($p) || $p =~ /(?:\s|\}|\+)/) &&<br></div><div>+ $remainder =~ /^(else)(?:\s|{)/ &&<br></div><div>+ $remainder !~ /^else\s+if\b/) {<br></div><div>+ $coff = $off + length($1) - 1;<br></div><div>+ $coff_set = 1;<br></div><div>+ #warn "CSB: mark coff<$coff> soff<$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 = '(';<br></div><div>+ }<br></div><div>+ if ($type eq '(' && $c eq ')') {<br></div><div>+ $level--;<br></div><div>+ $type = ($level != 0)? '(' : '';<br></div><div>+<br></div><div>+ if ($level == 0 && $coff < $soff) {<br></div><div>+ $coff = $off;<br></div><div>+ $coff_set = 1;<br></div><div>+ #warn "CSB: mark coff<$coff>\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 = '{';<br></div><div>+ }<br></div><div>+ if ($type eq '{' && $c eq '}') {<br></div><div>+ $level--;<br></div><div>+ $type = ($level != 0)? '{' : '';<br></div><div>+<br></div><div>+ if ($level == 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 == $len) {<br></div><div>+ $loff = $len + 1;<br></div><div>+ $line++;<br></div><div>+ $remain--;<br></div><div>+ }<br></div><div>+<br></div><div>+ my $statement = substr($blk, $soff, $off - $soff + 1);<br></div><div>+ my $condition = 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></div><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 ($stmt) = @_;<br></div><div>+<br></div><div>+ # Strip the diff line prefixes and rip blank lines at start and end.<br></div><div>+ $stmt =~ s/(^|\n)./$1/g;<br></div><div>+ $stmt =~ s/^\s*//;<br></div><div>+ $stmt =~ s/\s*$//;<br></div><div>+<br></div><div>+ my @stmt_lines = ($stmt =~ /\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) = @_;<br></div><div>+<br></div><div>+ my @stmt_lines = ($stmt =~ /\n/g);<br></div><div>+<br></div><div>+ return $#stmt_lines + 2;<br></div><div>+}<br></div><div>+<br></div><div>+sub statement_block_size {<br></div><div>+ my ($stmt) = @_;<br></div><div>+<br></div><div>+ $stmt =~ s/(^|\n)./$1/g;<br></div><div>+ $stmt =~ s/^\s*\{//;<br></div><div>+ $stmt =~ s/}\s*$//;<br></div><div>+ $stmt =~ s/^\s*//;<br></div><div>+ $stmt =~ s/\s*$//;<br></div><div>+<br></div><div>+ my @stmt_lines = ($stmt =~ /\n/g);<br></div><div>+ my @stmt_statements = ($stmt =~ /;/g);<br></div><div>+<br></div><div>+ my $stmt_lines = $#stmt_lines + 2;<br></div><div>+ my $stmt_statements = $#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) = @_;<br></div><div>+ my ($statement, $condition, $level);<br></div><div>+<br></div><div>+ my (@chunks);<br></div><div>+<br></div><div>+ # Grab the first conditional/block pair.<br></div><div>+ ($statement, $condition, $linenr, $remain, $off, $level) =<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 =~ /^\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, $level) =<br></div><div>+ ctx_statement_block($linenr, $remain, $off);<br></div><div>+ #print "C: c<$condition> s<$statement> remain<$remain>\n";<br></div><div>+ last if (!($remain > 0 && $condition =~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s));<br></div><div>+ #print "C: push\n";<br></div><div>+ push(@chunks, [ $condition, $statement ]);<br></div><div>+ }<br></div><div>+<br></div><div>+ return ($level, $linenr, @chunks);<br></div><div>+}<br></div><div>+<br></div><div>+sub ctx_block_get {<br></div><div>+ my ($linenr, $remain, $outer, $open, $close, $off) = @_;<br></div><div>+ my $line;<br></div><div>+ my $start = $linenr - 1;<br></div><div>+ my $blk = '';<br></div><div>+ my @o;<br></div><div>+ my @c;<br></div><div>+ my @res = ();<br></div><div>+<br></div><div>+ my $level = 0;<br></div><div>+ my @stack = ($level);<br></div><div>+ for ($line = $start; $remain > 0; $line++) {<br></div><div>+ next if ($rawlines[$line] =~ /^-/);<br></div><div>+ $remain--;<br></div><div>+<br></div><div>+ $blk .= $rawlines[$line];<br></div><div>+<br></div><div>+ # Handle nested #if/#else.<br></div><div>+ if ($lines[$line] =~ /^.\s*#\s*(?:ifndef|ifdef|if)\s/) {<br></div><div>+ push(@stack, $level);<br></div><div>+ } elsif ($lines[$line] =~ /^.\s*#\s*(?:else|elif)\b/) {<br></div><div>+ $level = $stack[$#stack - 1];<br></div><div>+ } elsif ($lines[$line] =~ /^.\s*#\s*endif\b/) {<br></div><div>+ $level = pop(@stack);<br></div><div>+ }<br></div><div>+<br></div><div>+ foreach my $c (split(//, $lines[$line])) {<br></div><div>+ ##print "C<$c>L<$level><$open$close>O<$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 == 0);<br></div><div>+ } elsif ($c eq $open) {<br></div><div>+ $level++;<br></div><div>+ }<br></div><div>+ }<br></div><div>+<br></div><div>+ if (!$outer || $level <= 1) {<br></div><div>+ push(@res, $rawlines[$line]);<br></div><div>+ }<br></div><div>+<br></div><div>+ last if ($level == 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><div>+ my ($linenr, $remain) = @_;<br></div><div>+<br></div><div>+ my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0);<br></div><div>+ return @r;<br></div><div>+}<br></div><div>+sub ctx_block {<br></div><div>+ my ($linenr, $remain) = @_;<br></div><div>+<br></div><div>+ my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0);<br></div><div>+ return @r;<br></div><div>+}<br></div><div>+sub ctx_statement {<br></div><div>+ my ($linenr, $remain, $off) = @_;<br></div><div>+<br></div><div>+ my ($level, @r) = ctx_block_get($linenr, $remain, 0, '(', ')', $off);<br></div><div>+ return @r;<br></div><div>+}<br></div><div>+sub ctx_block_level {<br></div><div>+ my ($linenr, $remain) = @_;<br></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) = @_;<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) = @_;<br></div><div>+<br></div><div>+ # Catch a comment on the end of the line itself.<br></div><div>+ my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@);<br></div><div>+ return $current_comment if (defined $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 = 0;<br></div><div>+ $current_comment = '';<br></div><div>+ for (my $linenr = $first_line; $linenr < $end_line; $linenr++) {<br></div><div>+ my $line = $rawlines[$linenr - 1];<br></div><div>+ #warn " $line\n";<br></div><div>+ if ($linenr == $first_line and $line =~ m@^.\s*\*@) {<br></div><div>+ $in_comment = 1;<br></div><div>+ }<br></div><div>+ if ($line =~ m@/\*@) {<br></div><div>+ $in_comment = 1;<br></div><div>+ }<br></div><div>+ if (!$in_comment && $current_comment ne '') {<br></div><div>+ $current_comment = '';<br></div><div>+ }<br></div><div>+ $current_comment .= $line . "\n" if ($in_comment);<br></div><div>+ if ($line =~ m@\*/@) {<br></div><div>+ $in_comment = 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) = @_;<br></div><div>+ my $cmt = 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>+ return ($cmt ne '');<br></div><div>+}<br></div><div>+<br></div><div>+sub raw_line {<br></div><div>+ my ($linenr, $cnt) = @_;<br></div><div>+<br></div><div>+ my $offset = $linenr - 1;<br></div><div>+ $cnt++;<br></div><div>+<br></div><div>+ my $line;<br></div><div>+ while ($cnt) {<br></div><div>+ $line = $rawlines[$offset++];<br></div><div>+ next if (defined($line) && $line =~ /^-/);<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) = @_;<br></div><div>+ my ($res, $coded);<br></div><div>+<br></div><div>+ $res = '';<br></div><div>+ while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) {<br></div><div>+ $res .= $1;<br></div><div>+ if ($2 ne '') {<br></div><div>+ $coded = sprintf("^%c", unpack('C', $2) + 64);<br></div><div>+ $res .= $coded;<br></div><div>+ }<br></div><div>+ }<br></div><div>+ $res =~ s/$/\$/;<br></div><div>+<br></div><div>+ return $res;<br></div><div>+}<br></div><div>+<br></div><div>+my $av_preprocessor = 0;<br></div><div>+my $av_pending;<br></div><div>+my @av_paren_type;<br></div><div>+my $av_pend_colon;<br></div><div>+<br></div><div>+sub annotate_reset {<br></div><div>+ $av_preprocessor = 0;<br></div><div>+ $av_pending = '_';<br></div><div>+ @av_paren_type = ('E');<br></div><div>+ $av_pend_colon = 'O';<br></div><div>+}<br></div><div>+<br></div><div>+sub annotate_values {<br></div><div>+ my ($stream, $type) = @_;<br></div><div>+<br></div><div>+ my $res;<br></div><div>+ my $var = '_' x length($stream);<br></div><div>+ my $cur = $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 = ('E') if ($#av_paren_type < 0);<br></div><div>+ print " <" . join('', @av_paren_type) .<br></div><div>+ "> <$type> <$av_pending>" if ($dbg_values > 1);<br></div><div>+ if ($cur =~ /^(\s+)/o) {<br></div><div>+ print "WS($1)\n" if ($dbg_values > 1);<br></div><div>+ if ($1 =~ /\n/ && $av_preprocessor) {<br></div><div>+ $type = pop(@av_paren_type);<br></div><div>+ $av_preprocessor = 0;<br></div><div>+ }<br></div><div>+<br></div><div>+ } elsif ($cur =~ /^(\(\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 = 'C';<br></div><div>+<br></div><div>+ } elsif ($cur =~ /^($Type)\s*(?:$Ident|,|\)|\(|\s*$)/) {<br></div><div>+ print "DECLARE($1)\n" if ($dbg_values > 1);<br></div><div>+ $type = 'T';<br></div><div>+<br></div><div>+ } elsif ($cur =~ /^($Modifier)\s*/) {<br></div><div>+ print "MODIFIER($1)\n" if ($dbg_values > 1);<br></div><div>+ $type = 'T';<br></div><div>+<br></div><div>+ } elsif ($cur =~ /^(\#\s*define\s*$Ident)(\(?)/o) {<br></div><div>+ print "DEFINE($1,$2)\n" if ($dbg_values > 1);<br></div><div>*** 1791 LINES SKIPPED ***<br></div><div><br></div></blockquote><div><br></div></body></html>help
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?5b9c31d2-4aaf-4822-b405-cae57164f314>