Generated: Sun Aug 21 11:11:11 2011 from lib_srcscan.pl 2011/03/06 8.9 KB.
#!/usr/bin/perl -w # NAME: lib_srcscan.pl - library # AIM: Read a C/C++ file, check for main(), and other things... # Params: # 1 - required - Source file name to scan # 2 - optional - BIT Options, for output mainly # 06/03/2011 - FIX20110306 - add MORE diagnostic concerning #if... parsing # 19/09/2010 - Make this lib_srcscan.pl, and only retain the chkmain2, now called src_scan # 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 use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) sub src_scan { my $fil = shift; my $opts = (@_) ? shift : 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 ($inc,$fndit,$qc,$tmp,$tmpc); my @ifstack = (); my @allifs = (); # FIX20110306 - only for diagnostics my @includes = (); my %results = (); my $fndm = 0; $fndit = 0; $ccnt = 0; if (!open INF, "<$fil") { prtw( "WARNING: Unable to open [$fil] file ... $! ...\n" ) if ($opts); $results{'LINE_COUNT'} = $ccnt; $results{'MAIN_COUNT'} = $fndm; $results{'MAIN_OTHER'} = $fndit; $results{'INCLUDES'} = \@includes; return \%results; } my @clines = <INF>; close INF; $ccnt = scalar @clines; $pline = ''; $incomm = 0; $tag = ''; $comment = ''; $lncomm = 0; $hadquotes = 0; $lnn = 0; prt("Processing $ccnt lines, from file [$fil]...(1)\n") if ($opts & 1); 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+(.+)/)) { $inc = $1; $inc =~ s/\s+\/\/.*$//; $inc =~ s/\s+\/\*.*$//; push(@includes, $inc); next; # skip '#include <main/main.h>' like INCLUDE lines } # FIX20110306 - Does NOT have to be a 'space', like '#if(WINVER >= 0x0400)' # if ($cline =~ /^\s*#\s*(if\w*)\s+(.+)/) { if ($cline =~ /^\s*#\s*(if\w*)\s*(.+)/) { push(@ifstack,"$1 $2"); $tmpc = scalar @ifstack; push(@allifs, "$lnn:$tmpc: $1 $2 [$cline]"); # FIX20110306 - only for diagnostics } elsif ($cline =~ /^\s*#\s*endif/) { if (@ifstack) { $tmpc = scalar @ifstack; $tmp = pop @ifstack; # FIX20110306 - keep popped, only for diagnostics push(@allifs, "$lnn:$tmpc: pop $tmp [$cline]"); # FIX20110306 - only for diagnostics } else { prtw( "WARNING:$fil:$lnn: line [$cline] ENDIF without stack!\n" ); $tmpc = scalar @allifs; prt("Full list of $tmpc #if parsing...\n"); foreach $tmp (@allifs) { prt("$tmp\n"); # FIX20110306 - only for diagnostics } } } $comment .= "\n" if length($comment); $lncomm = 0; $ch = ''; $hadquotes = 0; $minq = 0; for ($j = 0; $j < $ll; $j++) { $pch = $ch; $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 '"')||($ch eq "'")) { # start of QUOTE $qc = $ch; $j++; # to next char $quoted = $ch; $wd = ''; for ( ; $j < $ll; $j++) { $pch = $ch; $ch = substr($tline,$j,1); $quoted .= $ch; if (($ch eq $qc)&&($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! (4)\n" ) if ($opts & 4); $fndit++; } else { $fndm++; } } $tag = ''; } } } } if ($fnd1 && !$fndm && !$lncomm && !$incomm && !$wascomm && !$intest) { if ($hadquotes) { if ($minq) { prtw( "WARNING:$fil:$lnn: 'main' in quotes! CHECK no other! (8)\n" ) if ($opts & 8); } else { prtw( "WARNING:$fil:$lnn: MISSED main! But maybe in QUOTES! CHECK! (8)\n" ) if ($opts & 8); } } else { prtw( "\nERROR:$fil:$lnn: MISSED main! WHY??? (8)\n" ) if ($opts & 8); } if ($opts & 2) { prtw( "WARNING: LINE[$tline] (2)\n" ); } else { prt( "line=[".trim_all($tline)."] (16)\n" ) if ($opts & 16); } } $wascomm = $incomm; $pline = $cline; } # done all lines if (@ifstack) { $cline = "WARNING:$fil:$lnn: Still ".scalar @ifstack." items in IF stack!\n"; foreach $pline (@ifstack) { $cline .= "$pline "; } prtw("$cline (32)\n") if ($opts & 32); } #return $fndm; $results{'LINE_COUNT'} = $ccnt; $results{'MAIN_COUNT'} = $fndm; $results{'MAIN_OTHER'} = $fndit; $results{'INCLUDES'} = \@includes; return \%results; } sub recursive_src_scan($$$); sub recursive_src_scan($$$) { my ($fil,$opts,$rparams) = @_; my $rdh = ${$rparams}{'TMP_DONE_HASH'}; return if (defined ${$rdh}{$fil}); ${$rdh}{$fil} = 1; my $rh = src_scan($fil,$opts); ${$rparams}{'TMP_LINE_TOTAL'} += ${$rh}{'LINE_COUNT'}; my $key = 'INCLUDES'; if (defined ${$rh}{$key}) { my ($nam,$dir) = fileparse($fil); my $ra = ${$rh}{$key}; my ($inc,$ff,$fcnt,@srcs); foreach $inc (@{$ra}) { $inc =~ s/^<(.+)>$/$1/; $inc =~ s/^"(.+)"$/$1/; $ff = $dir.$inc; @srcs = (); if (-f $ff) { push(@srcs,$ff); } else { if ($inc =~ /(\\|\/)/) { my ($f2,$d2) = fileparse($inc); $fcnt = ac_is_file_in_scan($rparams,$f2,$d2,\@srcs); } else { $fcnt = ac_is_file_in_scan($rparams,$inc,$dir,\@srcs); } } foreach $ff (@srcs) { recursive_src_scan($ff,$opts,$rparams); } } } } sub full_src_scan_of_files($$$) { my ($rfils,$opts,$rparams) = @_; my %done = (); ${$rparams}{'TMP_DONE_HASH'} = \%done; ${$rparams}{'TMP_LINE_TOTAL'} = 0; my ($fil); foreach $fil (@{$rfils}) { recursive_src_scan($fil,$opts,$rparams); } return \%done; } 1; # eof - lib_srcscan.pl