Generated: Sat Oct 24 16:35:11 2020 from chkmain.pl 2020/07/12 9.5 KB. text copy
#!/perl -w # NAME: chkmain.pl - library # AIM: Read a C/C++ file and check for main() # 2010-07-07 - Some tidying when used in makesrcs.pl # 20090911 - version 2 with output indicator # 20090828 - check for quotes "...", and only WARN if could have been in quotes # 21/11/2007 - geoff mclane - http://geoffair.net/mperl # check_for_main - check for main() sub chkmain2($$) { my ($out,$fil) = @_; my $fndm = 0; my ($ccnt, $pline, $j, $k, $k2, $ch, $pch, $cline, $tline, $ll, $incomm, $tag, $fnd1, $comment); my ($lncomm, $wascomm, $hadquotes, $quoted, $wd, $minq, $lnn, $intest); my @ifstack = (); my @includes = (); if (open INF, "<$fil") { my @clines = <INF>; close INF; $ccnt = scalar @clines; $pline = ''; $incomm = 0; $tag = ''; $comment = ''; $lncomm = 0; $hadquotes = 0; $lnn = 0; ###prt( "\nProcessing $ccnt lines of $fil ...\n" ); for ($k = 0; $k < $ccnt; $k++) { $cline = $clines[$k]; $lnn++; $k2 = $k + 1; chomp $cline; $tline = $cline; # trim_all($cline); $ll = length($tline); $tag = ''; $fnd1 = 0; $intest = 0; if (($tline =~ /\s+main(\s|\()+/)|| ($tline =~ /^main(\s|\()+/)){ $fnd1 = 1; if (@ifstack) { $wd = $ifstack[-1]; # get LAST if ($wd =~ /TEST/i) { $intest = 1; } } } if ( !$incomm && ($tline =~ /^\s*#\s*include\s+(.+)/)) { push(@includes, $1); next; # skip '#include <main/main.h>' like INCLUDE lines } if ($cline =~ /^\s*#\s*if\w*\s+(.+)/) { push(@ifstack,$1); } elsif ($cline =~ /^\s*#\s*endif/) { if (@ifstack) { pop @ifstack; } else { prtw( "WARNING:$fil:$lnn: line [$cline] ENDIF without stack!\n" ); } } $comment .= "\n" if length($comment); $lncomm = 0; $pch = ''; $hadquotes = 0; $minq = 0; for ($j = 0; $j < $ll; $j++) { $ch = substr($tline,$j,1); if ($incomm) { # only looking for CLOSE comment */ $comment .= $ch; if (($ch eq '/') && ($pch eq '*')) { $incomm = 0; } } else { if ($ch eq '"') { # start of QUOTE $j++; # to next char $pch = $ch; $quoted = $ch; $wd = ''; for ( ; $j < $ll; $j++) { $ch = substr($tline,$j,1); $quoted .= $ch; if (($ch eq '"')&&($pch ne "\\")) { last; # out of here } $pch = $ch; if ($ch =~ /\w/) { $wd .= $ch; } elsif (length($wd)) { $minq = 1 if ($wd eq 'main'); $wd = ''; } } $hadquotes++; } elsif (($ch eq '*') && ($pch eq '/')) { # comment start /* until */ $incomm = 1; $wascomm = 1; $comment = $pch.$ch; } elsif (($ch eq '/') && ($pch eq '/')) { $j = $ll; # skip rest of line $lncomm = 1; } else { if ($ch =~ /\w+/) { #if ($ch =~ /[main]/) { $tag .= $ch; } else { # NOT alphanumeric if ($tag eq 'main') { #prt( "Found a main ...\n" ); #prt( "$tline\n" ); #push(@mains, $tline); if ($intest) { prtw("WARNING:$fil:$lnn: line[$cline] NOT counted, since in 'TEST' switch - BUT CHECK!\n" ); } else { $fndm++; } } $tag = ''; } } } $pch = $ch; } ###prt( "line $k2:[$tline]$ll ($incomm:$lncomm) $fnd1 $fndm\n" ); #if ($fnd1 && !$fndm && !$lncomm && !$incomm && !$wascomm) if ($fnd1 && !$fndm && !$lncomm && !$incomm && !$wascomm && !$intest) { if ($hadquotes) { if ($minq) { if ($out & 1) { prtw( "WARNING:$fil:$lnn: 'main' in quotes! CHECK no other!\n" ); } else { prt("NOTE: found 'main' but appears to be in 'quotes' - skipped\n" ); } } else { prtw( "\nWARNING:$fil:$lnn: MISSED main! But maybe in QUOTES! CHECK!\n" ); } } else { prtw( "\nERROR:$fil:$lnn: MISSED main! WHY???\n" ); } if ($out & 1) { prtw( "WARNING: LINE[$tline]\n" ); } else { prt( "line=[".trim_all($tline)."]\n" ); } } $wascomm = $incomm; $pline = $cline; } } else { prtw( "WARNING: Unable to open [$fil] file ... $! ...\n" ); } if (@ifstack) { $cline = "WARNING:$fil:$lnn: Still ".scalar @ifstack." items in IF stack!\n"; foreach $pline (@ifstack) { $cline .= "$pline "; } prtw( "$cline\n" ); } return $fndm; } sub chkmain { my ($fil) = shift; return chkmain2(-1,$fil); } sub chk_main { my ($fil,$rarr) = @_; my $fndm = 0; my ($ccnt, $pline, $j, $k, $k2, $ch, $pch, $cline, $tline, $ll, $incomm, $tag, $fnd1, $comment); my ($lncomm, $wascomm, $iftxt, $msg, $bch, $main, $ml, $mi, $cond); my @ifopen = (); my @conditional_stack = (); if (open INF, "<$fil") { my @clines = <INF>; close INF; $ccnt = scalar @clines; $pline = ''; $incomm = 0; $tag = ''; $comment = ''; $lncomm = 0; $iftxt = ''; $msg = ''; ###prt( "\nProcessing $ccnt lines of $fil ...\n" ); for ($k = 0; $k < $ccnt; $k++) { $cline = $clines[$k]; $k2 = $k + 1; chomp $cline; $tline = trim_all($cline); $ll = length($tline); $tag = ''; $fnd1 = 0; if ( !$incomm) { if ( $tline =~ /^\s*#\s*include\s+/ ) { next; # skip '#include <main/main.h>' like INCLUDE lines } elsif ($tline =~ /^\s*#\s*if(.*)/ ) { $iftxt = $1; if ($iftxt =~ /^def\s+(.*)/ ) { $msg = "Got ifdef [$1] ... TRUE"; push (@conditional_stack, "\@" . $1 . "_TRUE\@"); } elsif ($iftxt =~ /^\s+(.*)/ ) { $msg = "Got if [$1] ... TRUE"; push (@conditional_stack, "\@" . $1 . "_TRUE\@"); } else { $msg = "CHECK ME: What is this? [$tline]\n"; } ###prt( "$msg\n" ); next; } elsif ($tline =~ /^\s*#\s*else(.*)/ ) { $msg = "Got else ..."; if (! @conditional_stack) { $msg .= "ERROR: else without if"; } elsif ($conditional_stack[$#conditional_stack] =~ /_FALSE\@$/) { $msg .= "ERROR: else after else"; } else { $msg .= "tog ".$conditional_stack[$#conditional_stack]; $conditional_stack[$#conditional_stack] =~ s/_TRUE\@$/_FALSE\@/; $msg .= " to ".$conditional_stack[$#conditional_stack]; } ###prt( "$msg\n" ); next; } elsif ($tline =~ /^\s*#\s*endif(.*)/ ) { $msg = "Got endif ..."; if (! @conditional_stack) { $msg .= "ERROR: endif without if"; } else { $msg = "pop ". pop @conditional_stack; } ###prt( "$msg\n" ); next; } } $pline = ''; $comment .= "\n" if length($comment); $lncomm = 0; $pch = ''; $bch = ' '; for ($j = 0; $j < $ll; $j++) { $ch = substr($tline,$j,1); if ($incomm) { # only looking for CLOSE comment */ $comment .= $ch; if (($ch eq '/') && ($pch eq '*')) { $incomm = 0; $tline = substr($tline,$j); $ll = length($tline); $j = 0; $ch = ''; $bch = ' '; } $pch = $ch; next; } else { if ($ch eq '"') { # start of QUOTE $j++; # to next char $pch = $ch; for ( ; $j < $ll; $j++) { $ch = substr($tline,$j,1); if (($ch eq '"')&&($pch ne "\\")) { last; # out of here } $pch = $ch; } } elsif (($ch eq '*') && ($pch eq '/')) { # comment start /* until */ $incomm = 1; $wascomm = 1; $comment = $pch.$ch; } elsif (($ch eq '/') && ($pch eq '/')) { $j = $ll; # skip rest of line $lncomm = 1; } else { if ($ch =~ /\w+/) { #if ($ch =~ /[main]/) { $tag .= $ch; } else { # NOT alphanumeric if (($tag eq 'main')&&($bch eq ' ')&&(($ch =~ /\s/)||($ch eq '('))) { $mi = $j + 1; for ($mi = $j + 1; $mi < $ll; $mi++) { if (substr($tline,$mi,1) eq ')') { $mi++; last; } } $main = substr($tline,0,$mi); $main = substr($main,1) if ($main =~ /^\//); #prt( "Found a main ... [$main]\n" ); $msg = ''; if (@conditional_stack) { foreach $cond (@conditional_stack) { $msg .= " && " if (length($msg)); $msg .= $cond; } } $fndm++; push(@{$rarr}, [$k2, $main, $msg]); ###prt( "$fndm: Found main [$main] cond [$msg]\n" ); } $tag = ''; $bch = $ch; } } } $pch = $ch; $pline .= $ch; } if (($pline =~ /\s+main(\s|\()+/)|| ($pline =~ /^main(\s|\()+/)){ $fnd1 = 1; } ###prt( "line $k2:[$tline]$ll ($incomm:$lncomm) $fnd1 $fndm\n" ); if ($fnd1 && !$fndm && !$lncomm && !$incomm && !$wascomm) { prt( "\nERROR: MISSED main! WHY??? [$fil]\n" ); prt( "CHECK ME [$pline]\n" ); } $wascomm = $incomm; } } else { prt( "WARNING: Unable to open [$fil] file ... $! ...\n" ); } return $fndm; } 1; # eof - chkmain.pl