# GCOV tool
# (1) Compile cactus with gcc using the options
# -fprofile-arcs and -ftest-coverage
# (2) Run the test suite
# (3) from the Cactus dir, run GcovAnalysis.pl
# usage:
# perl GcovAnalysis.pl configuration_name
use strict;
use FileHandle;
use Data::Dumper;
use Cwd;
my $cwd = Cwd::getcwd()."/";
# for debugging only
my $count = 0;
my $done = 0;
# $ARGV[0] should be a configuration name
my $dir = "configs/$ARGV[0]";
# Die if we can't find the config.
die $dir unless(-d $dir);
my %executed = ();
my $lines = {};
# search the directories and call gcov
do_dir($dir);
# do post gcov analysis
finish();
sub do_dir {
my $fd = new FileHandle;
my $f = shift;
if($f =~ /\.(gcno|gcda)$/) {
my $pre = $`;
if(-r "$pre.gcda" and -r "$pre.gcno" and -r "$pre.o") {
# We can only call gcov if we have both the
# gcda and the gcno file
gcov("$pre.o");
#$done = 1 if($count++ == 20);
last if($done);
} else {
# We are missing one of the files needed by
# gcov. We mark line 0 as not being executed
# in order to make the src file show up on
# index.html. Since there is no line 0, no
# red mark shows up when displaying the file.
my $unused = "$cwd$pre";
# There are no capital F's in the config dir
$unused =~ s/\.F$/.f/;
$unused =~ s/\.F90$/.f90/;
$unused =~ s/\.F77$/.f77/;
$lines->{$unused}->{0} = 0;
}
}
if(-d $f) {
opendir($fd,$f) or die $f;
while(my $fn = readdir($fd)) {
next if($fn eq ".");
next if($fn eq "..");
last if($done);
my $full = "$f/$fn";
# ignore automatically generated code as well as ExternalLibraries
unless ($full =~ m'.*/cctk_Bindings$' or
$full =~ m'.*/bindings$' or
$full =~ m'.*/scratch$' or
$full =~ m'.*/build/CactusBindings$') {
do_dir($full);
}
}
closedir($fd);
}
}
sub finish {
# Create the index.html file
my $colors = new FileHandle;
open($colors,">index.html");
my $xdir = undef;
my $table = {};
my $fileids = {};
my $fileid = 1;
my $yes = 0;
my $no = 0;
# Count up lines with zero count (no's), or
# more than zero (yes's). Keep track by
# directory, etc.
for my $src (sort keys %$lines) {
my $cn = 0;
my $tot = 0;
my $lo = undef;
my $hi = undef;
my $lsrc = $src;
my $pre = "";
my $range = "";
unless($lsrc =~ s{^${cwd}}{}) {
#print "SKIPPING $lsrc\n";
next;
}
$lsrc =~ s{^${dir}/}{};
# Find the directory for this file.
# The arrangement dir is special.
next unless($lsrc =~ m{arrangements/[^/]*/[^/]*/|.*/});
my $ndir = $&;
my $nfile = $';
# Assign a unique id to each file
$fileids->{$src} = $fileid++ unless(defined($fileids->{$src}));
for my $line (sort { $a <=> $b } keys %{$lines->{$src}}) {
if($lines->{$src}->{$line} == 0) {
$no++;
$table->{$ndir}->{dir}->{no}++;
$table->{$ndir}->{file}->{$nfile}->{no}++;
} else {
$yes++;
$table->{$ndir}->{dir}->{yes}++;
$table->{$ndir}->{file}->{$nfile}->{yes}++;
}
}
my $sfd = new FileHandle;
my $wfd = new FileHandle;
my $outfile = sprintf("file%05d.html",$fileids->{$src});
# Skip files that we can't locate
open($sfd,$src) or open($sfd,"/dev/null");
open($wfd,">$outfile") or die $outfile;
my $lineno = 1;
print $wfd "\n";
print $wfd "\n";
print $wfd "| File: | $src |
\n";
while(my $line = <$sfd>) {
my $col = "code";
my $lcol = "code";
if(defined($lines->{$src}->{$lineno})) {
if($lines->{$src}->{$lineno} == 0) {
$col = "bline";
$lcol = "bcode"
} else {
$col = "gline";
$lcol = "gcode";
}
}
# Some characters are treated specially in html
my %e = ("<" => "<",">" => ">","&" => "&"," " => " ","\t" => " ");
$line =~ s/[<>& \t]/$e{$&}/g;
printf $wfd "| %5d | :%s |
\n",$lineno,$line;
$lineno++;
}
print $wfd "