Newer
Older
# (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;
my $P = $0;
use Getopt::Long qw(:config no_auto_abbrev);
my $quiet = 0;
my $tree = 1;
my $chk_signoff = 1;
my $chk_patch = 1;
my $summary = 1;
my $mailback = 0;
my %ignore_type = ();
my @ignore = ();
my $help = 0;
my $configuration_file = ".checkpatch.conf";
sub help {
my ($exitcode) = @_;
print << "EOM";
Usage: $P [OPTION]... [FILE]...
Version: $V
Options:
-q, --quiet quiet
--no-tree run without a kernel tree
--no-signoff do not check for 'Signed-off-by' line
--patch treat FILE as patchfile (default)
--emacs emacs compile window format
--terse one line per report
-f, --file treat FILE as regular source file
--subjective, --strict enable more subjective tests
--ignore TYPE(,TYPE2...) ignore various comma separated message types
--show-types show the message "types" in the output
--root=PATH PATH to the kernel tree root
--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
-h, --help, --version display this help and exit
When FILE is - read standard input.
EOM
exit($exitcode);
}
my $conf = which_conf($configuration_file);
if (-f $conf) {
my @conf_args;
open(my $conffile, '<', "$conf")
or warn "$P: Can't find a readable $configuration_file file $!\n";
while (<$conffile>) {
my $line = $_;
$line =~ s/\s*\n?$//g;
$line =~ s/^\s*//g;
$line =~ s/\s+/ /g;
next if ($line =~ m/^\s*#/);
next if ($line =~ m/^\s*$/);
my @words = split(" ", $line);
foreach my $word (@words) {
last if ($word =~ m/^#/);
push (@conf_args, $word);
}
}
close($conffile);
unshift(@ARGV, @conf_args) if @conf_args;
}
'tree!' => \$tree,
'signoff!' => \$chk_signoff,
'patch!' => \$chk_patch,
'f|file!' => \$file,
'subjective!' => \$check,
'strict!' => \$check,
'ignore=s' => \@ignore,
'show-types!' => \$show_types,
'summary!' => \$summary,
'mailback!' => \$mailback,
'summary-file!' => \$summary_file,
'h|help' => \$help,
'version' => \$help
) or help(1);
help(0) if ($help);
my $exit = 0;
if ($#ARGV < 0) {
print "$P: no input files\n";
@ignore = split(/,/, join(',',@ignore));
foreach my $word (@ignore) {
$word =~ s/\s*\n?$//g;
$word =~ s/^\s*//g;
$word =~ s/\s+/ /g;
$word =~ tr/[a-z]/[A-Z]/;
next if ($word =~ m/^\s*#/);
next if ($word =~ m/^\s*$/);
$ignore_type{$word}++;
}
my $dbg_values = 0;
my $dbg_possible = 0;
## no critic
eval "\${dbg_$key} = '$debug{$key}';";
die "$@" if ($@);
my $rpt_cleaners = 0;
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);
}
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{
__user|
__kernel|
__force|
__iomem|
__must_check|
__init_refok|
# Notes to $Attribute:
# We need \b after 'init' otherwise 'initconst' will cause a false positive in a check
__percpu|
__nocast|
__safe|
__bitwise__|
__packed__|
__packed2__|
__naked|
__maybe_unused|
__always_unused|
__noreturn|
__used|
__cold|
__noclone|
__deprecated|
__(?:mem|cpu|dev|)(?:initdata|initconst|init\b)|
____cacheline_aligned|
____cacheline_aligned_in_smp|
____cacheline_internodealigned_in_smp|
__weak
our $Inline = qr{inline|__always_inline|noinline};
our $Member = qr{->$Ident|\.$Ident|\[[^]]*\]};
our $Lval = qr{$Ident(?:$Member)*};
our $Constant = qr{(?i:(?:[0-9]+|0x[0-9a-f]+)[ul]*)};
our $Assignment = qr{(?:\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=)};
our $Compare = qr{<=|>=|==|!=|<|>};
our $Operators = qr{
<=|>=|==|!=|
=>|->|<<|>>|<|>|!|~|
&&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|%
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;
our $typeTypedefs = qr{(?x:
(?:__)?(?:u|s|be|le)(?:8|16|32|64)|
our $logFunctions = qr{(?x:
printk(?:_ratelimited|_once|)|
[a-z0-9]+_(?:printk|emerg|alert|crit|err|warning|warn|notice|info|debug|dbg|vdbg|devel|cont|WARN)(?:_ratelimited|_once|)|
WARN(?:_RATELIMIT|_ONCE|)|
panic|
MODULE_[A-Z_]+
)};
our $signature_tags = qr{(?xi:
Signed-off-by:|
Acked-by:|
Tested-by:|
Reviewed-by:|
Reported-by:|
To:|
Cc:
)};
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},
);
our $allowed_asm_includes = qr{(?x:
irq|
memory
)};
# memory.h: ARM has a custom one
my $mods = "(?x: \n" . join("|\n ", @modifierList) . "\n)";
my $all = "(?x: \n" . join("|\n ", @typeList) . "\n)";
$Modifier = qr{(?:$Attribute|$Sparse|$mods)};
(?:$Modifier\s+|const\s+)*
(?:typeof|__typeof__)\s*\([^\)]*\)|
(?:\s+$Modifier|\s+const)*
(?:(?:\s|\*|\[\])+\s*const|(?:\s|\*|\[\])+|(?:\s*\[\s*\])+)?
(?:\s+$Inline|\s+$Modifier)*
}x;
$Declare = qr{(?:$Storage\s+)?$Type};
}
build_types();
our $Typecast = qr{\s*(\(\s*$NonptrType\s*\)){0,1}\s*};
# Using $balanced_parens, $LvalOrFunc, or $FuncArg
# requires at least perl version v5.10.0
# Any use must be runtime checked with $^V
our $balanced_parens = qr/(\((?:[^\(\)]++|(?-1))*\))/;
our $LvalOrFunc = qr{($Lval)\s*($balanced_parens{0,1})\s*};
our $FuncArg = qr{$Typecast{0,1}($LvalOrFunc|$Constant)};
sub deparenthesize {
my ($string) = @_;
return "" if (!defined($string));
$string =~ s@^\s*\(\s*@@g;
$string =~ s@\s*\)\s*$@@g;
$string =~ s@\s+@ @g;
return $string;
}
my @dep_includes = ();
my @dep_functions = ();
my $removal = "Documentation/feature-removal-schedule.txt";
if ($tree && -f "$root/$removal") {
open(my $REMOVE, '<', "$root/$removal") ||
die "$P: $removal: open failed - $!\n";
if (/^Check:\s+(.*\S)/) {
for my $entry (split(/[, ]+/, $1)) {
if ($entry =~ m@include/(.*)@) {
} elsif ($entry !~ m@/@) {
push(@dep_functions, $entry);
}
open($FILE, '-|', "diff -u /dev/null $filename") ||
die "$P: $filename: diff failed - $!\n";
} elsif ($filename eq '-') {
open($FILE, '<&STDIN');
die "$P: $filename: open failed - $!\n";
if ($filename eq '-') {
$vname = 'Your patch';
} else {
$vname = $filename;
}
chomp;
push(@rawlines, $_);
}
$exit = 1;
}
@rawlines = ();
}
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;
}
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
sub parse_email {
my ($formatted_email) = @_;
my $name = "";
my $address = "";
my $comment = "";
if ($formatted_email =~ /^(.*)<(\S+\@\S+)>(.*)$/) {
$name = $1;
$address = $2;
$comment = $3 if defined $3;
} elsif ($formatted_email =~ /^\s*<(\S+\@\S+)>(.*)$/) {
$address = $1;
$comment = $2 if defined $2;
} elsif ($formatted_email =~ /(\S+\@\S+)(.*)$/) {
$address = $1;
$comment = $2 if defined $2;
$formatted_email =~ s/$address.*$//;
$name = $formatted_email;
$name =~ s/^\s+|\s+$//g;
$name =~ s/^\"|\"$//g;
# If there's a name left after stripping spaces and
# leading quotes, and the address doesn't have both
# leading and trailing angle brackets, the address
# is invalid. ie:
# "joe smith joe@smith.com" bad
# "joe smith <joe@smith.com" bad
if ($name ne "" && $address !~ /^<[^>]+>$/) {
$name = "";
$address = "";
$comment = "";
}
}
$name =~ s/^\s+|\s+$//g;
$name =~ s/^\"|\"$//g;
$address =~ s/^\s+|\s+$//g;
$address =~ s/^\<|\>$//g;
if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
$name =~ s/(?<!\\)"/\\"/g; ##escape quotes
$name = "\"$name\"";
}
return ($name, $address, $comment);
}
sub format_email {
my ($name, $address) = @_;
my $formatted_email;
$name =~ s/^\s+|\s+$//g;
$name =~ s/^\"|\"$//g;
$address =~ s/^\s+|\s+$//g;
if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
$name =~ s/(?<!\\)"/\\"/g; ##escape quotes
$name = "\"$name\"";
}
if ("$name" eq "") {
$formatted_email = "$address";
} else {
$formatted_email = "$name <$address>";
}
return $formatted_email;
}
sub which_conf {
my ($conf) = @_;
foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
if (-e "$path/$conf") {
return "$path/$conf";
}
}
return "";
}
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 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 = '';
# 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;
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/) {
$res =~ s@(\#\s*(?:error|warning)\s+).*@$1$clean@;
sub ctx_statement_block {
my ($linenr, $remain, $off) = @_;
my $line = $linenr - 1;
my $blk = '';
my $soff = $off;
my $coff = $off - 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]);
$len = length($blk);
$line++;
last;
}
# Bail if there is no further context.
#warn "CSB: blk<$blk> off<$off> len<$len>\n";
if ($level == 0 && substr($blk, $off) =~ /^.\s*#\s*define/) {
$level++;
$type = '#';
}
#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++;
}
# Preprocessor commands end at the newline unless escaped.
if ($type eq '#' && $c eq "\n" && $p ne "\\") {
$level--;
$type = '';
$off++;
last;
}
# We are truly at the end, so shuffle to the next line.
$loff = $len + 1;
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);
}
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
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);
my ($linenr, $remain, $outer, $open, $close, $off) = @_;
my $line;
my $start = $linenr - 1;
my $blk = '';
my @o;
my @c;
my @res = ();
my @stack = ($level);
for ($line = $start; $remain > 0; $line++) {
next if ($rawlines[$line] =~ /^-/);
$remain--;
$blk .= $rawlines[$line];
# Handle nested #if/#else.
Andy Whitcroft
committed
if ($lines[$line] =~ /^.\s*#\s*(?:ifndef|ifdef|if)\s/) {
push(@stack, $level);
Andy Whitcroft
committed
} elsif ($lines[$line] =~ /^.\s*#\s*(?:else|elif)\b/) {
$level = $stack[$#stack - 1];
Andy Whitcroft
committed
} elsif ($lines[$line] =~ /^.\s*#\s*endif\b/) {
$level = pop(@stack);
}
Andy Whitcroft
committed
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++;
}
}
}
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;
my ($linenr, $remain, $off) = @_;
my ($level, @r) = ctx_block_get($linenr, $remain, 0, '(', ')', $off);
return @r;
}
sub ctx_block_level {
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.
Andy Whitcroft
committed
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;