#!/usr/bin/perl -w# (c) 2001, Dave Jones. <davej@redhat.com> (the file handling bit)# (c) 2005, Joel Schopp <jschopp@austin.ibm.com> (the ugly bit)# (c) 2007, Andy Whitcroft <apw@uk.ibm.com> (new conditions, test suite, etc)# Licensed under the terms of the GNU GPL License version 2 use strict; my $P = $0;$P =~ s@.*/@@g; my $V = '0.24'; use Getopt::Long qw(:config no_auto_abbrev); my $quiet = 0;my $tree = 1;my $chk_signoff = 1;my $chk_patch = 1;my $tst_only;my $emacs = 0;my $terse = 0;my $file = 0;my $check = 0;my $summary = 1;my $mailback = 0;my $summary_file = 0;my $root;my %debug;GetOptions( 'q|quiet+' => \$quiet, 'tree!' => \$tree, 'signoff!' => \$chk_signoff, 'patch!' => \$chk_patch, 'emacs!' => \$emacs, 'terse!' => \$terse, 'file!' => \$file, 'subjective!' => \$check, 'strict!' => \$check, 'root=s' => \$root, 'summary!' => \$summary, 'mailback!' => \$mailback, 'summary-file!' => \$summary_file, 'debug=s' => \%debug, 'test-only=s' => \$tst_only,) or exit; my $exit = 0; if ($#ARGV < 0) { print "usage: $P [options] patchfile\n"; print "version: $V\n"; print "options: -q => quiet\n"; print " --no-tree => run without a kernel tree\n"; print " --terse => one line per report\n"; print " --emacs => emacs compile window format\n"; print " --file => check a source file\n"; print " --strict => enable more subjective tests\n"; print " --root => path to the kernel tree root\n"; print " --no-summary => suppress the per-file summary\n"; print " --summary-file => include the filename in summary\n"; exit(1);} my $dbg_values = 0;my $dbg_possible = 0;my $dbg_type = 0;my $dbg_attr = 0;for my $key (keys %debug) { eval "\${dbg_$key} = '$debug{$key}';"} if ($terse) { $emacs = 1; $quiet++;} if ($tree) { if (defined $root) { if (!top_of_kernel_tree($root)) { die "$P: $root: --root does not point at a valid tree\n"; } } else { if (top_of_kernel_tree('.')) { $root = '.'; } elsif ($0 =~ m@(.*)/scripts/[^/]*$@ && top_of_kernel_tree($1)) { $root = $1; } } if (!defined $root) { print "Must be run from the top-level dir. of a kernel tree\n"; exit(2); }} my $emitted_corrupt = 0; our $Ident = qr{[A-Za-z_][A-Za-z\d_]*};our $Storage = qr{extern|static|asmlinkage};our $Sparse = qr{ __user| __kernel| __force| __iomem| __must_check| __init_refok| __kprobes }x;our $Attribute = qr{ const| __read_mostly| __kprobes| __(?:mem|cpu|dev|)(?:initdata|init)| ____cacheline_aligned| ____cacheline_aligned_in_smp| ____cacheline_internodealigned_in_smp }x;our $Modifier;our $Inline = qr{inline|__always_inline|noinline};our $Member = qr{->$Ident|\.$Ident|\[[^]]*\]};our $Lval = qr{$Ident(?:$Member)*}; our $Constant = qr{(?:[0-9]+|0x[0-9a-fA-F]+)[UL]*};our $Assignment = qr{(?:\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=)};our $Operators = qr{ <=|>=|==|!=| =>|->|<<|>>|<|>|!|~| &&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|% }x; our $NonptrType;our $Type;our $Declare; our $UTF8 = qr { [\x09\x0A\x0D\x20-\x7E] # ASCII | [\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 $typeTypedefs = qr{(?x: (?:__)?(?:u|s|be|le)(?:\d|\d\d)| atomic_t)}; 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},);our @modifierList = ( qr{fastcall},); sub build_types { my $mods = "(?x: \n" . join("|\n ", @modifierList) . "\n)"; my $all = "(?x: \n" . join("|\n ", @typeList) . "\n)"; $Modifier = qr{(?:$Attribute|$Sparse|$mods)}; $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 @dep_includes = ();my @dep_functions = ();my $removal = "Documentation/feature-removal-schedule.txt";if ($tree && -f "$root/$removal") { open(REMOVE, "<$root/$removal") || die "$P: $removal: open failed - $!\n"; while (<REMOVE>) { if (/^Check:\s+(.*\S)/) { for my $entry (split(/[, ]+/, $1)) { if ($entry =~ m@include/(.*)@) { push(@dep_includes, $1); } elsif ($entry !~ m@/@) { push(@dep_functions, $entry); } } } }} my @rawlines = ();my @lines = ();my $vname;for my $filename (@ARGV) { if ($file) { open(FILE, "diff -u /dev/null $filename|") || die "$P: $filename: diff failed - $!\n"; } else { open(FILE, "<$filename") || die "$P: $filename: open failed - $!\n"; } if ($filename eq '-') { $vname = 'Your patch'; } else { $vname = $filename; } while (<FILE>) { chomp; push(@rawlines, $_); } close(FILE); if (!process($filename)) { $exit = 1; } @rawlines = (); @lines = ();} exit($exit); sub top_of_kernel_tree { my ($root) = @_; my @tree_check = ( "COPYING", "CREDITS", "Kbuild", "MAINTAINERS", "Makefile", "README", "Documentation", "arch", "include", "drivers", "fs", "init", "ipc", "kernel", "lib", "scripts", ); foreach my $check (@tree_check) { if (! -e $root . '/' . $check) { return 0; } } return 1;} sub expand_tabs { my ($str) = @_; my $res = ''; my $n = 0; for my $c (split(//, $str)) { if ($c eq "\t") { $res .= ' '; $n++; for (; ($n % 8) != 0; $n++) { $res .= ' '; } next; } $res .= $c; $n++; } return $res;}sub copy_spacing { (my $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 completly 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; } # 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 "SQ:$sanitise_quote\n"; if ($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); } } # 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 $p; my $c; my $len = 0; my $remainder; while (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"; # 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) { 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 {Lines 1–500 of 2515. Load more
#!/usr/bin/perl -w # (c) 2001, Dave Jones. <davej@redhat.com> (the file handling bit) # (c) 2005, Joel Schopp <jschopp@austin.ibm.com> (the ugly bit) # (c) 2007, Andy Whitcroft <apw@uk.ibm.com> (new conditions, test suite, etc) # Licensed under the terms of the GNU GPL License version 2 use strict; my $P = $0; $P =~ s@.*/@@g; my $V = '0.24'; use Getopt::Long qw(:config no_auto_abbrev); my $quiet = 0; my $tree = 1; my $chk_signoff = 1; my $chk_patch = 1; my $tst_only; my $emacs = 0; my $terse = 0; my $file = 0; my $check = 0; my $summary = 1; my $mailback = 0; my $summary_file = 0; my $root; my %debug; GetOptions( 'q|quiet+' => \$quiet, 'tree!' => \$tree, 'signoff!' => \$chk_signoff, 'patch!' => \$chk_patch, 'emacs!' => \$emacs, 'terse!' => \$terse, 'file!' => \$file, 'subjective!' => \$check, 'strict!' => \$check, 'root=s' => \$root, 'summary!' => \$summary, 'mailback!' => \$mailback, 'summary-file!' => \$summary_file, 'debug=s' => \%debug, 'test-only=s' => \$tst_only, ) or exit; my $exit = 0; if ($#ARGV < 0) { print "usage: $P [options] patchfile\n"; print "version: $V\n"; print "options: -q => quiet\n"; print " --no-tree => run without a kernel tree\n"; print " --terse => one line per report\n"; print " --emacs => emacs compile window format\n"; print " --file => check a source file\n"; print " --strict => enable more subjective tests\n"; print " --root => path to the kernel tree root\n"; print " --no-summary => suppress the per-file summary\n"; print " --summary-file => include the filename in summary\n"; exit(1); } my $dbg_values = 0; my $dbg_possible = 0; my $dbg_type = 0; my $dbg_attr = 0; for my $key (keys %debug) { eval "\${dbg_$key} = '$debug{$key}';" } if ($terse) { $emacs = 1; $quiet++; } if ($tree) { if (defined $root) { if (!top_of_kernel_tree($root)) { die "$P: $root: --root does not point at a valid tree\n"; } } else { if (top_of_kernel_tree('.')) { $root = '.'; } elsif ($0 =~ m@(.*)/scripts/[^/]*$@ && top_of_kernel_tree($1)) { $root = $1; } } if (!defined $root) { print "Must be run from the top-level dir. of a kernel tree\n"; exit(2); } } my $emitted_corrupt = 0; our $Ident = qr{[A-Za-z_][A-Za-z\d_]*}; our $Storage = qr{extern|static|asmlinkage}; our $Sparse = qr{ __user| __kernel| __force| __iomem| __must_check| __init_refok| __kprobes }x; our $Attribute = qr{ const| __read_mostly| __kprobes| __(?:mem|cpu|dev|)(?:initdata|init)| ____cacheline_aligned| ____cacheline_aligned_in_smp| ____cacheline_internodealigned_in_smp }x; our $Modifier; our $Inline = qr{inline|__always_inline|noinline}; our $Member = qr{->$Ident|\.$Ident|\[[^]]*\]}; our $Lval = qr{$Ident(?:$Member)*}; our $Constant = qr{(?:[0-9]+|0x[0-9a-fA-F]+)[UL]*}; our $Assignment = qr{(?:\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=)}; our $Operators = qr{ <=|>=|==|!=| =>|->|<<|>>|<|>|!|~| &&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|% }x; our $NonptrType; our $Type; our $Declare; our $UTF8 = qr { [\x09\x0A\x0D\x20-\x7E] # ASCII | [\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 $typeTypedefs = qr{(?x: (?:__)?(?:u|s|be|le)(?:\d|\d\d)| atomic_t )}; 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}, ); our @modifierList = ( qr{fastcall}, ); sub build_types { my $mods = "(?x: \n" . join("|\n ", @modifierList) . "\n)"; my $all = "(?x: \n" . join("|\n ", @typeList) . "\n)"; $Modifier = qr{(?:$Attribute|$Sparse|$mods)}; $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 @dep_includes = (); my @dep_functions = (); my $removal = "Documentation/feature-removal-schedule.txt"; if ($tree && -f "$root/$removal") { open(REMOVE, "<$root/$removal") || die "$P: $removal: open failed - $!\n"; while (<REMOVE>) { if (/^Check:\s+(.*\S)/) { for my $entry (split(/[, ]+/, $1)) { if ($entry =~ m@include/(.*)@) { push(@dep_includes, $1); } elsif ($entry !~ m@/@) { push(@dep_functions, $entry); } } } } } my @rawlines = (); my @lines = (); my $vname; for my $filename (@ARGV) { if ($file) { open(FILE, "diff -u /dev/null $filename|") || die "$P: $filename: diff failed - $!\n"; } else { open(FILE, "<$filename") || die "$P: $filename: open failed - $!\n"; } if ($filename eq '-') { $vname = 'Your patch'; } else { $vname = $filename; } while (<FILE>) { chomp; push(@rawlines, $_); } close(FILE); if (!process($filename)) { $exit = 1; } @rawlines = (); @lines = (); } exit($exit); sub top_of_kernel_tree { my ($root) = @_; my @tree_check = ( "COPYING", "CREDITS", "Kbuild", "MAINTAINERS", "Makefile", "README", "Documentation", "arch", "include", "drivers", "fs", "init", "ipc", "kernel", "lib", "scripts", ); foreach my $check (@tree_check) { if (! -e $root . '/' . $check) { return 0; } } return 1; } sub expand_tabs { my ($str) = @_; my $res = ''; my $n = 0; for my $c (split(//, $str)) { if ($c eq "\t") { $res .= ' '; $n++; for (; ($n % 8) != 0; $n++) { $res .= ' '; } next; } $res .= $c; $n++; } return $res; } sub copy_spacing { (my $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 completly 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; } # 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 "SQ:$sanitise_quote\n"; if ($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); } } # 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 $p; my $c; my $len = 0; my $remainder; while (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"; # 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) { 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 {