Hui Zhou
394df8648a
This fixes the spelling errors for the rest of the repository, excluding the files excluded in spellcheck.sh.
997 linhas
31 KiB
Perl
997 linhas
31 KiB
Perl
#! /usr/bin/env perl
|
|
##
|
|
## Copyright (C) by Argonne National Laboratory
|
|
## See COPYRIGHT in top-level directory
|
|
##
|
|
|
|
# This script extracts information from files produced by gcov showing what
|
|
# parts of each file have *not* been executed by the test programs.
|
|
#
|
|
# Normally, this script should *not* be used directly; instead, use
|
|
# maint/createcoverage
|
|
# The createcoverave script uses this (getcoverage) script to create the
|
|
# coverage information.
|
|
#
|
|
# To create a coverage report using this script, use the following steps:
|
|
#
|
|
# configure --enable-coverage <other options>
|
|
# make
|
|
# make install
|
|
# make testing
|
|
# < run other tests, such as the Intel, MPICH1, and C++ tests >
|
|
# make coverage
|
|
# maint/getcoverage src/mpi src/util > coverage.txt
|
|
#
|
|
# The script in mpich-tests/getcoverage will perform all of these steps
|
|
# (this script is not yet included with the MPICH distribution)
|
|
#
|
|
# As an option, create HTML versions of the files with the uncovered code
|
|
# highlighted with a different background color (e.g., pale red). These
|
|
# should be placed into the same directory structure as the original source
|
|
# files, but with a different root ($annoteSrcDir)
|
|
#
|
|
# ToDo:
|
|
# Another useful option for graphical output would be to keep track of the
|
|
# percentage of covered lines and produce an "xdu"-style map of the
|
|
# coverage, with color indicating the fraction of coverage.
|
|
#
|
|
# The GNU tools sometimes incorrectly mark "break" statements within a
|
|
# case statement as not executed. As break can also be used in a loop, where
|
|
# it is an executable statement, we can't just ignore breaks, and we can't
|
|
# determine which type the break is without parsing the program :(.
|
|
#
|
|
use warnings;
|
|
|
|
$includeFileInOutput = 0;
|
|
$skipErrExits = 1;
|
|
$outputUncovered = 1;
|
|
@UnCalled = ();
|
|
@TopFilenames = (); # Array of files and directories provided on the
|
|
# command line
|
|
@CoveredFiles = (); # Array of files that are ok
|
|
# annoteSrcDir is where the annotation files are placed,
|
|
# annoteBaseDir is the base file name that is stripped from the
|
|
# file names
|
|
$annoteSrcDir = "";
|
|
$annoteWebPrefix = "";
|
|
$CoverageMessage = ""; # Extra message for the coverage index file
|
|
$indexfile = ""; # File to contain the index of files
|
|
$annoteFiles = 0;
|
|
$annoteBaseDir = "";
|
|
%AnnoteFilesMap = (); # Clear the list of files
|
|
%AnnoteMissed = (); # Clear the mapping of filenames to "missed;total" lines
|
|
%AnnoteFilesToOrig = (); # Map from annotated file key to original name (used for
|
|
# indexing into AnnoteMissed)
|
|
$gDebug = 0;
|
|
$gDebugDetail = 0;
|
|
|
|
# The line leaders are used to provide a common set of expressions to match
|
|
# the beginning of a line. This matches the output from the gcov tools.
|
|
# There are two of these because the output from the tools associtated with
|
|
# gcc version 2.x and 3.x are different.
|
|
# As, apparently is 4.x.
|
|
# We also permit an isolated open or close brace on the line (a non-executable
|
|
# statement)
|
|
$lineLeader2 = '^\s*[\{\}]?\s*';
|
|
$lineLeader3 = '^\s*-:\s*\d+:\s*[\{\}]?\s*';
|
|
$lineLeader4 = '^\s*[0-9-]+:\s*\d+:\s*[\{\}]?\s*';
|
|
#
|
|
# This is the list of known block names. They represent several types of
|
|
# code for which it may be desirable not to count in coverage analysis.
|
|
# Code that normally should not be executed:
|
|
# DEBUG - Code for debugging
|
|
# EXPERIMENTAL - Experimental code that will normally not be executed
|
|
# Code that may be executed, but for which it is difficult to write
|
|
# coverage tests
|
|
# USEREXTENSION - Code that provides for user extensions, particularly
|
|
# through places where user-provided functions may be called
|
|
# OPTIONALINIT - Code that provides for lazy initialization of
|
|
# datastructures, particularly function tables.
|
|
# Code that is executed only with erroneous input (e.g., user errors) or
|
|
# exceptional events (e.g., socket unexpectedly closes).
|
|
# ERROR HANDLING - Code for handling or reporting errors
|
|
@BlockNames = ( "DEBUG", "ERROR HANDLING", "EXPERIMENTAL", "USEREXTENSION",
|
|
"OPTIONALINIT" );
|
|
#
|
|
# Keep track of coverage amounts
|
|
$GrandTotal = 0;
|
|
$GrandTotalMissed = 0;
|
|
$GrandTotalExec = 0;
|
|
|
|
# gfilename is used to hold the current open file for READING, so
|
|
# that error messages can be more specific
|
|
$gFilename = "";
|
|
|
|
# ----------------------------------------------------------------------------
|
|
for (@ARGV) {
|
|
if (/-webpages=(.*)/) {
|
|
# Create the coverage in default web pages for the device
|
|
# named as an argument (e.g., maint/getcoverage -webpages=ch3:sock)
|
|
my $device = $1;
|
|
my $weblocbase = "@abs_mpichsrcdir@/www/coverage";
|
|
my $webloc = $weblocbase . "/$device";
|
|
$annoteSrcDir = $webloc;
|
|
$annoteFiles = 1;
|
|
$annoteWebPrefix = "";
|
|
$indexdir = $webloc;
|
|
$indexfile = "$indexdir/index.htm";
|
|
$coveredindexfile = "$indexdir/covered.htm";
|
|
if (! -d $indexdir) { &MakeDirs( $indexfile ); }
|
|
next;
|
|
}
|
|
elsif (/-annote=(.*)/) {
|
|
# Create an annotation of the source data in the specified root
|
|
# directory
|
|
$annoteSrcDir = $1;
|
|
$annoteFiles = 1;
|
|
next;
|
|
}
|
|
elsif (/-annoteweb=(.*)/) {
|
|
# annoteweb gives the URL that matches the annoteSrcDir.
|
|
$annoteWebPrefix = $1;
|
|
next;
|
|
}
|
|
elsif (/-index=(.*)/) {
|
|
$indexfile = $1;
|
|
next;
|
|
}
|
|
elsif (/-indexdir=(.*)/) {
|
|
# This target sets the directory for the index file, along with
|
|
# the file that contains the names of the files that are
|
|
# considered completely covered.
|
|
my $indexdir = $1;
|
|
$indexfile = "$indexdir/index.htm";
|
|
$coveredindexfile = "$indexdir/covered.htm";
|
|
if (! -d $indexdir) { &MakeDirs( $indexfile ); }
|
|
next;
|
|
}
|
|
elsif (/-coveredmsg=(.*)/) {
|
|
$CoverageMessage = $1;
|
|
next;
|
|
}
|
|
elsif (/-debugall/) {
|
|
$gDebugDetail = 1;
|
|
$gDebug = 1;
|
|
}
|
|
elsif (/-debug/) {
|
|
$gDebug = 1;
|
|
next;
|
|
}
|
|
|
|
$TopFilenames[$#TopFilenames + 1] = $_;
|
|
}
|
|
# ----------------------------------------------------------------------------
|
|
|
|
# ----------------------------------------------------------------------------
|
|
|
|
for my $filename (@TopFilenames) {
|
|
if (-d $filename) {
|
|
# Check for a "pmpi" directory - one that was used to merge
|
|
# PMPI and MPI outputs. If found, we skip to the next directory
|
|
if ($filename =~ /\-pmpi$/) { next; }
|
|
# Added to handle a change in the naming convention for object files
|
|
# in MPICH, which now needs a -mpi directory as well as the -pmpi
|
|
# directory needed to handle the pmpi object files.
|
|
if ($filename =~ /\-mpi$/) { next; }
|
|
# Expand the directory into a list of files. If there are
|
|
# subdirectories, expand them too (e.g., get a list of
|
|
# *every* file within the directory tree.
|
|
@files = &ExpandDir( $filename );
|
|
foreach my $file (@files) {
|
|
($missed_lines,$total_lines,$execLines) =
|
|
&CountUncoveredLines( $file );
|
|
$GrandTotal += $total_lines;
|
|
$GrandTotalMissed += $missed_lines;
|
|
$GrandTotalExec += $execLines;
|
|
$AnnoteMissed{$file} = "$missed_lines;$total_lines;$execLines";
|
|
if ($missed_lines) {
|
|
print "$missed_lines line(s) not covered by tests in $file\n";
|
|
&WriteAnnoteFile( $file, $total_lines, $execLines, $missed_lines );
|
|
}
|
|
else {
|
|
print "All code covered by tests in $file\n";
|
|
$CoveredFiles[$#CoveredFiles+1] = $file;
|
|
}
|
|
}
|
|
}
|
|
elsif (-s $filename) {
|
|
($missed_lines,$total_lines,$execLines) =
|
|
&CountUncoveredLines( $filename );
|
|
$GrandTotal += $total_lines;
|
|
$GrandTotalMissed += $missed_lines;
|
|
$GrandTotalExec += $execLines;
|
|
$AnnoteMissed{$filename} = "$missed_lines;$total_lines;$execLines";
|
|
print "$filename - $missed_lines missed lines\n" if $gDebug;
|
|
if ($missed_lines) {
|
|
print "$missed_lines line(s) not covered by tests in $filename\n";
|
|
&WriteAnnoteFile( $filename, $total_lines, $execLines, $missed_lines );
|
|
}
|
|
else {
|
|
print "All code covered by tests in $filename\n";
|
|
$CoveredFiles[$#CoveredFiles+1] = $filename;
|
|
}
|
|
}
|
|
else {
|
|
print "Cannot open $filename\n";
|
|
}
|
|
}
|
|
|
|
for $routine (@UnCalled) {
|
|
print STDERR "$routine never called\n";
|
|
}
|
|
|
|
if ($annoteFiles && $indexfile ne "") {
|
|
# Here is where we could process the list of files that were annotated
|
|
&WriteAnnoteFileMap( $indexfile );
|
|
if ($coveredindexfile ne "") {
|
|
WriteCoveredFileMap( $coveredindexfile );
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------------
|
|
# Here begin the support routines
|
|
# ----------------------------------------------------------------------------
|
|
# Count the number of uncovered lines, and return that number.
|
|
sub CountUncoveredLines {
|
|
my $filename = $_[0];
|
|
my $missed_lines = 0;
|
|
my $headerOutput = 0;
|
|
my $linecount = 0; # Line in the coverage file
|
|
my $fileline = 0; # Line in the original file
|
|
my $executableLines = 0; # Number of lines that could be executed
|
|
my $lastLineOut = -1;
|
|
my ($lineincr, $filelineincr); # Used to update linecount,fileline
|
|
my $oldLine;
|
|
my $lastLine;
|
|
|
|
open( FD, "<$filename" ) || die "Could not open $filename\n";
|
|
$gFilename = $filename; # Export filename for error reporting
|
|
|
|
# Note that linecount is relative to the foo.c.gcov file, not the
|
|
# original foo.c file.
|
|
# Gcc 3.x changed the output format (including a line number and
|
|
# a - for unexecuted lines, i.e.,
|
|
# ^\s*-:\s*\d+:original-text-line
|
|
|
|
L: while (<FD>) {
|
|
$linecount++;
|
|
# Coverage messages appear to always begin in the first column.
|
|
if (/^\s/) { $fileline++; }
|
|
# Skip any error checking block
|
|
if (/^\s*#\s*ifdef\s+HAVE_ERROR_CHECKING/ ||
|
|
/^\s*-:\s*\d+:\s*#\s*ifdef\s+HAVE_ERROR_CHECKING/) {
|
|
while (<FD>) {
|
|
$linecount++;
|
|
if (/^\s/) { $fileline++; }
|
|
if (/^\s+#\s*endif/ || /^\s*#\s*els/ ||
|
|
/^\s*-:\s*\d+:\s*#\s*endif/ || /^\s*-:\s*\d+:\s*#\s*els/) {
|
|
last;
|
|
}
|
|
}
|
|
next;
|
|
}
|
|
|
|
# Skip any blocks marked as debugging or unavoidable error checking
|
|
# code
|
|
foreach my $name (@BlockNames) {
|
|
if (/$lineLeader2\/\*\s+--BEGIN $name--\s+\*\// ||
|
|
/$lineLeader3\/\*\s+--BEGIN $name--\s+\*\// ||
|
|
/$lineLeader4\/\*\s+--BEGIN $name--\s+\*\//) {
|
|
# It is usually an error to encounter a block begin
|
|
# within another block. The exception is the
|
|
# EXPERIMENTAL block, which may contain ERROR HANDLING blocks
|
|
my $allowNest = 0;
|
|
if ($name eq "EXPERIMENTAL") { $allowNest = 1; }
|
|
($lineincr,$filelineincr) =
|
|
&skipBlock( $name, $allowNest, $linecount );
|
|
$linecount += $lineincr;
|
|
$fileline += $filelineincr;
|
|
next L;
|
|
}
|
|
}
|
|
|
|
# If requested, skip obvious error checking lines
|
|
# The errflag set should really be an MPIR_ERR macro; the
|
|
# test is designed to accept only lines that set that flag
|
|
# and nothing else.
|
|
if ($skipErrExits &&
|
|
(/FUNC_EXIT.*STATE/ || /MPIR_Err_return_/ ||
|
|
/MPIR_ERR_SET/ || /MPIR_ERR_POP/ || /MPIR_ERR_CHECK/ || /goto\s+fn_fail/ ||
|
|
/MPIR_ERR_ADD/ || /\*errflag\s*=\s*[^;]*;\s*$/ ||
|
|
/fn_fail:/ || /MPIR_Err_create_code/)) {
|
|
next;
|
|
}
|
|
|
|
# Gcc 3.3 generates a different output form (!) with only
|
|
# 5 sharps instead of 6. It does mark lines that are not
|
|
# executable with a -, which is an improvement
|
|
if (/^\s*######?/) {
|
|
# First, ignore a few odd markings by gcov
|
|
if (/^\s*######?\s*\}\s*$/ || /^\s*######?\s*:\s*\d+:\s*\}\s*$/) {
|
|
# Ignore a closed brace
|
|
next;
|
|
}
|
|
|
|
$missed_lines++;
|
|
$executableLines++; # This missed line is executable
|
|
|
|
if ($outputUncovered) {
|
|
if (!$headerOutput) {
|
|
print "\nUncovered lines in $filename\n";
|
|
$headerOutput = 1;
|
|
}
|
|
if ($lastLineOut < $linecount - 2) {
|
|
my $ll = $linecount - 2;
|
|
print "$ll:\t$oldLine";
|
|
}
|
|
if ($lastLineOut < $linecount - 1) {
|
|
my $ll = $linecount - 1;
|
|
print "$ll:\t$lastLine";
|
|
}
|
|
print "$linecount:\t$_";
|
|
$lastLineOut = $linecount;
|
|
}
|
|
}
|
|
elsif (/^\s*-:/) {
|
|
;
|
|
# Not (at least to gcov) an executable line
|
|
}
|
|
elsif (/^\s*\d+:/) {
|
|
# A line that was executed at least once
|
|
$executableLines++;
|
|
}
|
|
if ($includeFileInOutput) {
|
|
print $_;
|
|
}
|
|
$oldLine = $lastLine;
|
|
$lastLine = $_;
|
|
}
|
|
close (FD);
|
|
return ($missed_lines,$fileline,$executableLines);
|
|
}
|
|
|
|
# ----------------------------------------------------------------------------
|
|
# Annotate a file by placing the uncovered lines in bgcolor
|
|
# AnnotateUncoveredLines( coveragefile, bgcolor, filenhandle )
|
|
#
|
|
# This uses a state machine to move between the states of:
|
|
# init - beginning (top of file)
|
|
# unex - within unexecuted code
|
|
# exec - within executed code
|
|
# skip - within skipped code (code that we don't care whether it is
|
|
# executed). Currently contains 3 sub states:
|
|
# errcheck (error checking code)
|
|
# ERROR HANDLING (error handling code)
|
|
# DEBUG (debug code)
|
|
# EXPERIMENTAL (experimental)
|
|
# USEREXTENSION (code to enable user extensions)
|
|
# The uppercase names are the same as the @BlockNames.
|
|
# Currently, the skipcolors are all lightblue
|
|
sub AnnotateUncoveredLines {
|
|
my $filename = $_[0];
|
|
my $bgcolor = $_[1];
|
|
my %skipcolors = ( "errcheck" => "lightblue",
|
|
"ERROR HANDLING" => "lightblue",
|
|
"DEBUG" => "lightblue",
|
|
"EXPERIMENTAL" => "lightblue",
|
|
"USEREXTENSION" => "lightyellow",
|
|
"OPTIONALINIT" => "lightgreen",
|
|
);
|
|
my $outfile = $_[2];
|
|
my $curstate = "init"; # Current state
|
|
my $newstate; # New state implied by the last line read
|
|
my $substate; # Used for substates within a state (skip only)
|
|
my $newline = "\r\n";
|
|
|
|
open( FD, "<$filename" ) || die "Could not open $filename\n";
|
|
$gFilename = $filename;
|
|
|
|
print $outfile "<TABLE>$newline";
|
|
|
|
# Note that linecount is relative to the foo.c.gcov file, not the
|
|
# original foo.c file.
|
|
L2: while (<FD>) {
|
|
# Skip coverage messages (always start in the first column)
|
|
if (! /^\s/) { next; }
|
|
|
|
# TODO:
|
|
# If there is neither a "######" nor a count in front of the
|
|
# line, and it is not a comment or blank space, it has
|
|
# the same state as currently in (e.g., it is probably a
|
|
# continuation line).
|
|
# Determine what state this line is in
|
|
# (gcc 3.3 only outputs 5 sharps, earlier versions use 6)
|
|
# The format of the line also changed
|
|
if ($skipErrExits &&
|
|
(/FUNC_EXIT.*STATE/ || /MPIR_Err_return_/ ||
|
|
/MPIR_ERR_SET/ || /MPIR_ERR_POP/ || /MPIR_ERR_CHECK/ || /goto\s+fn_fail/ ||
|
|
/MPIR_ERR_ADD/ || /\*errflag\s*=\s*[^;]*;\s*$/ ||
|
|
/fn_fail:/ || /MPIR_Err_create_code/)) {
|
|
# If requested, skip obvious error checking lines
|
|
$newstate = "skip";
|
|
$substate = "errcheck";
|
|
}
|
|
elsif (/^\s*######?/) {
|
|
$newstate = "unex";
|
|
}
|
|
elsif (/^\s*\d+\s/ ||
|
|
/^\s*\d+:\s*\d+:/) {
|
|
# Also had /^\s*-:\s*\d+:/, but this should really be "same state"
|
|
# to avoid flipping in and out of a state.
|
|
$newstate = "exec";
|
|
}
|
|
else {
|
|
# Keep the same state...
|
|
if ($curstate eq "init") {
|
|
$newstate = "exec";
|
|
}
|
|
else {
|
|
$newstate = $curstate;
|
|
}
|
|
}
|
|
|
|
# Special cases for blocks that we skip (mark them as executed)
|
|
if (/^\s*#\s*ifdef\s+HAVE_ERROR_CHECKING/ ||
|
|
/^\s*-:\s*\d+:\s*#\s*ifdef\s+HAVE_ERROR_CHECKING/) {
|
|
$newstate = "skip";
|
|
$substate = "errcheck";
|
|
}
|
|
else {
|
|
foreach my $name (@BlockNames) {
|
|
if (/$lineLeader2\/\*\s+--BEGIN $name--\s+\*\// ||
|
|
/$lineLeader3\/\*\s+--BEGIN $name--\s+\*\// ||
|
|
/$lineLeader4\/\*\s+--BEGIN $name--\s+\*\//) {
|
|
$newstate = "skip";
|
|
$substate = $name;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
# If there is a change in state, generate the correct code
|
|
if ($newstate ne $curstate) {
|
|
print STDERR "Newstate = $newstate\n" if $gDebugDetail;
|
|
if ($curstate ne "init") {
|
|
# Finish off the current state
|
|
print $outfile "</PRE></TD></TR>$newline";
|
|
}
|
|
if ($newstate eq "exec") { $bgcolor = "white"; }
|
|
elsif ($newstate eq "unex") { $bgcolor = "red"; }
|
|
elsif ($newstate eq "skip") {
|
|
$bgcolor = $skipcolors{$substate};
|
|
}
|
|
else {
|
|
print STDERR "Internal error: unrecognized state $newstate\n";
|
|
}
|
|
print $outfile "<TR><TD BGCOLOR=\"$bgcolor\" WIDTH=100%><PRE>$newline";
|
|
}
|
|
$curstate = $newstate;
|
|
|
|
# Add this line
|
|
print $outfile &HTMLify($_);
|
|
|
|
# Now, for the blocks that we skip, read them until we reach the
|
|
# end of the block
|
|
# Skip any error checking block
|
|
if (/^\s*#\s*ifdef\s+HAVE_ERROR_CHECKING/ ||
|
|
/^\s*-:\s*\d+:\s*#\s*ifdef\s+HAVE_ERROR_CHECKING/) {
|
|
my $sawend = 0;
|
|
print STDERR "Skipping HAVE_ERROR_CHECKING\n" if $gDebugDetail;
|
|
while (<FD>) {
|
|
if (!/^\s/) { next; }
|
|
print $outfile &HTMLify($_);
|
|
if (/^\s+#\s*endif/ || /^\s*#\s*els/ ||
|
|
/^\s*-:\s*\d+:\s*#\s*endif/ ||
|
|
/^\s*-:\s*\d+:\s*#\s*els/) {
|
|
$sawend = 1;
|
|
last;
|
|
}
|
|
}
|
|
if (!$sawend) {
|
|
print STDERR "File $gFilename ended in HAVE ERROR CHECKING block\n";
|
|
}
|
|
next;
|
|
}
|
|
# Skip any blocks marked as debugging or unavoidable error checking
|
|
# code
|
|
foreach my $name (@BlockNames) {
|
|
if (/$lineLeader2\/\*\s+--BEGIN $name--\s+\*\// ||
|
|
/$lineLeader3\/\*\s+--BEGIN $name--\s+\*\// ||
|
|
/$lineLeader4\/\*\s+--BEGIN $name--\s+\*\//) {
|
|
&skipBlockAndAnnotate( $outfile, $name );
|
|
next L2;
|
|
}
|
|
}
|
|
|
|
|
|
}
|
|
close (FD);
|
|
print $outfile "</PRE></TD></TR>$newline</TABLE>$newline";
|
|
}
|
|
|
|
# Write the annotation file as a simple HTML file
|
|
# (returns immediately if annotations are not requested)
|
|
# To aid in navigating the annotation pages
|
|
#
|
|
# WriteAnnoteFile( filename, total_lines, exec_lines, missed_lines )
|
|
# Also inserts the generated filename to the hash %AnnoteFilesMap
|
|
# with key the base filename (e.g., foo.c) and the value the
|
|
# full directory path (e.g., $annoteSrcDir/foo.c.htm)
|
|
sub WriteAnnoteFile {
|
|
my $filename = $_[0];
|
|
my $totalLines = $_[1];
|
|
my $execLines = $_[2];
|
|
my $missedLines = $_[3];
|
|
|
|
print "Writing (if $annoteFiles) annotated file $filename\n" if $gDebug;
|
|
if ($annoteFiles) {
|
|
# Make a file name
|
|
my $basefile = $filename;
|
|
$basefile =~ s/\.merge$//; # Remove "merge" from filename
|
|
$basefile =~ s/\.gcov//;
|
|
$basefile =~ s/$annoteBaseDir//;
|
|
my $OUTFD = OUTFD;
|
|
my $rc = &MakeDirs( "$annoteSrcDir/$basefile" );
|
|
if ($rc == 0) {
|
|
print STDERR "Could not create directories $annoteSrcDir/$basefile\n";
|
|
return;
|
|
}
|
|
print STDERR "Opening $annoteSrcDir/$basefile.htm\n" if $gDebug;
|
|
$rc = open( $OUTFD, ">$annoteSrcDir/$basefile.htm" );
|
|
if ($rc != 0) {
|
|
$AnnoteFilesMap{$basefile} = "$annoteSrcDir/$basefile.htm";
|
|
$AnnoteFilesToOrig{$basefile} = $filename;
|
|
print STDERR "Saving $filename as AnnoteFilesToOrig{$basefile}\n" if $gDebug;
|
|
$newline = "\r\n";
|
|
print $OUTFD "<HTML><HEAD>$newline" || die "writing header";
|
|
print $OUTFD "<TITLE>Coverage for $filename</TITLE>$newline";
|
|
print $OUTFD "</HEAD>$newline";
|
|
print $OUTFD "<BODY BGCOLOR=\"FFFFFF\">$newline";
|
|
my $percent = sprintf( "%2d", 100 * $missedLines / $execLines );
|
|
print $OUTFD "For $filename, $missedLines lines of code out of $execLines executable lines were not executed ($percent\% missed)<P>$newline";
|
|
|
|
&AnnotateUncoveredLines( $filename, "red", $OUTFD );
|
|
print $OUTFD "</BODY></HTML>$newline";
|
|
close( $OUTFD );
|
|
}
|
|
else {
|
|
print STDERR "Cannot open $annoteSrcDir/$basefile\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# TODO: Create a map of the annotated files by using AnnoteFilesMap
|
|
# We need a better framework for this. Perhaps a table with multiple
|
|
# columns. We could also arrange in groups by directory names
|
|
#
|
|
# WriteAnnoteFileMap( name-fo-file-to-write )
|
|
sub WriteAnnoteFileMap {
|
|
my @names = sort(keys(%AnnoteFilesMap));
|
|
my $indexfile = $_[0];
|
|
#my $date = `date "+%Y-%m-%d-%H-%M"`;
|
|
my $date = `date`;
|
|
# FilesByMissed is a semicolon separated list of files, indexed by the
|
|
# number of lines missed. This will allow us to list the top problems
|
|
# in terms of the number of uncovered lines.
|
|
my %FilesByMissed = ();
|
|
|
|
open (IFD, ">$indexfile" ) || die "Could not open $indexfile\n";
|
|
|
|
print IFD "<HTML><HEAD><TITLE>Index to coverage analysis</TITLE></HEAD>\n";
|
|
print IFD "<BODY BGCOLOR=\"FFFFFF\">\n";
|
|
|
|
# Create the heading
|
|
if ($GrandTotal > 0 && $GrandTotalMissed > 0) {
|
|
print IFD "<H2>Summary of Coverage Testing</H2>\n";
|
|
print IFD "Of $GrandTotal lines in code, $GrandTotalMissed lines were not covered\n";
|
|
my $percent = (100 * $GrandTotalMissed) / $GrandTotal;
|
|
my $covered = 100 - $percent;
|
|
# convert to strings
|
|
$percent = sprintf( "%.2f", $percent );
|
|
$covered = sprintf( "%.2f", $covered );
|
|
print IFD "or $percent% missed ($covered% covered)\n";
|
|
# Do the same, but for the executable lines
|
|
print IFD "<br>Of $GrandTotalExec executable lines in code, $GrandTotalMissed lines were not covered\n";
|
|
$percent = (100 * $GrandTotalMissed) / $GrandTotalExec;
|
|
$covered = 100 - $percent;
|
|
# convert to strings
|
|
$percent = sprintf( "%.2f", $percent );
|
|
$covered = sprintf( "%.2f", $covered );
|
|
print IFD "or $percent% missed ($covered% covered)\n";
|
|
|
|
my $date = `date "+%Y-%m-%d-%H-%M"`;
|
|
print IFD "<br>This index created on $date\n";
|
|
if ($CoverageMessage ne "") {
|
|
print IFD "<br>$CoverageMessage<br>\n"
|
|
}
|
|
print IFD "<p>\n";
|
|
print IFD "The following files contained some code that was not executed. Files in which all non-error-handling, non-debug code was executed are not shown\n"
|
|
}
|
|
|
|
my $col = 1;
|
|
my $maxcol = 4;
|
|
my $curprefix = "--NONE--";
|
|
for ($i=0; $i<=$#names; $i++) {
|
|
my $file = $names[$i];
|
|
my $target = $AnnoteFilesMap{$file};
|
|
|
|
# Clean up filename
|
|
$file =~ s/^\.\///;
|
|
if ($file =~ /(.*)\/([^\/]*)/) {
|
|
$dirname = $1;
|
|
$basename = $2;
|
|
}
|
|
else {
|
|
$dirname = "";
|
|
$basename = $file;
|
|
}
|
|
|
|
# Clean up target
|
|
if ($annoteWebPrefix ne "") {
|
|
$target =~ s/$annoteSrcDir/$annoteWebPrefix/;
|
|
}
|
|
else {
|
|
# make the reference relative
|
|
$target =~ s/$annoteSrcDir\///;
|
|
}
|
|
|
|
# Compare dirname to curprefix; start a new table if
|
|
# necessary
|
|
if ($dirname ne $curprefix) {
|
|
if ($curprefix ne "--NONE--") {
|
|
for (my $j=$col-1; $j<=$maxcol; $j++) {
|
|
print IFD "<TD></TD>";
|
|
}
|
|
print IFD "</TR></TABLE>\n";
|
|
}
|
|
$curprefix = $dirname;
|
|
print IFD "<H2>$dirname</H2>\n";
|
|
print IFD "<TABLE WIDTH=100%>\n";
|
|
$col = 1;
|
|
}
|
|
if ($col == 1) {
|
|
print IFD "<TR WIDTH=100%>\n";
|
|
}
|
|
my $label = $basename;
|
|
my $origFileName = $AnnoteFilesToOrig{$names[$i]};
|
|
my $missed;
|
|
my $total;
|
|
if (defined($AnnoteMissed{$origFileName})) {
|
|
($missed,$total) = split(/;/,$AnnoteMissed{$origFileName});
|
|
$label = "$label ($missed)";
|
|
}
|
|
# FIXME:
|
|
# Allow relative rather than absolute targets
|
|
print IFD "<TD><A HREF=\"$target\">$label</A></TD>\n";
|
|
if ($col++ == $maxcol) {
|
|
print IFD "</TR>\n";
|
|
$col = 1;
|
|
}
|
|
if (defined($FilesByMissed{$missed})) {
|
|
$FilesByMissed{$missed} .= ";$dirname/$basename($target)";
|
|
}
|
|
else {
|
|
$FilesByMissed{$missed} = "$dirname/$basename($target)";
|
|
}
|
|
}
|
|
|
|
# Flush the final table
|
|
if ($curprefix ne "--NONE--") {
|
|
# In case the page is empty
|
|
if ($col > 1) {
|
|
for (my $i=$col-1; $i<=$maxcol; $i++) {
|
|
print IFD "<TD></TD>";
|
|
}
|
|
print IFD "</TR>\n";
|
|
}
|
|
print IFD "</TABLE>\n";
|
|
}
|
|
|
|
print IFD "<P><HR>\n<h2>Files with the most coverage gaps</h2>\n";
|
|
foreach my $key (sort {$b <=> $a} keys(%FilesByMissed)) {
|
|
if ($key < 10) { last; }
|
|
print IFD "($key): ";
|
|
foreach my $file (split(/;/,$FilesByMissed{$key})) {
|
|
if ($file =~ /(.*)\((.*)\)/) {
|
|
print IFD "<A HREF=\"$2\">$1</A>\n";
|
|
}
|
|
else {
|
|
print IFD "$file\n";
|
|
}
|
|
}
|
|
print IFD "<BR>\n";
|
|
}
|
|
|
|
print IFD "<P><HR>\nGenerated on $date\n";
|
|
print IFD "</BODY></HTML>\n";
|
|
close IFD;
|
|
}
|
|
|
|
# -
|
|
# ( $coveredindexfile );
|
|
# This needs to be updated
|
|
sub WriteCoveredFileMap {
|
|
my $filename = $_[0];
|
|
my $newline = "\r\n";
|
|
|
|
open ( IFD, ">$filename" ) || die "Cannot open $filename\n";
|
|
|
|
print IFD "<HTML><HEAD>$newline";
|
|
print IFD "<TITLE>List of fully covered files</TITLE>$newline";
|
|
print IFD "</HEAD>$newline";
|
|
print IFD "<BODY BGCOLOR=\"FFFFFF\">$newline";
|
|
@sortedfiles = sort ( @CoveredFiles );
|
|
# for (my $i = 0; $i <= $#sortedfiles; $i ++ ) {
|
|
# my $file = $sortedfiles[$i];
|
|
# print IFD "$file\n";
|
|
# }
|
|
# This both avoids calling OutputFileTable if the array is empty
|
|
# and keeps Perl from issuing a warning about sortedfiles having
|
|
# only one use.
|
|
if ($#sortedfiles >= 0) {
|
|
&OutputFileTable( IFD, "sortedfiles", "" );
|
|
}
|
|
print IFD "</BODY></HTML>$newline";
|
|
close( IFD );
|
|
}
|
|
|
|
# -
|
|
# Make all of the directories in filename (which may include a
|
|
# final file). If it contains only directories, make sure that
|
|
# the name ends in a /
|
|
sub MakeDirs {
|
|
my $filename = $_[0];
|
|
|
|
my @subdirs = split(/\//, $filename );
|
|
print STDERR "Size of subdirs is $#subdirs\n" if $gDebugDetail;
|
|
my $curdir = $subdirs[0];
|
|
if ($curdir eq "") { $curdir = "/"; }
|
|
my $rc = 0;
|
|
for($i=1; $i<=$#subdirs; $i++) {
|
|
print STDERR "Making $curdir\n" if $gDebugDetail;
|
|
if (! -d $curdir) {
|
|
$rc = mkdir $curdir;
|
|
if (!$rc) {
|
|
print STDERR "Could not make directory $curdir\n";
|
|
return $rc;
|
|
}
|
|
}
|
|
if (! ($curdir =~ /\/$/)) { $curdir .= "/"; }
|
|
$curdir .= "$subdirs[$i]";
|
|
}
|
|
return 1;
|
|
}
|
|
# Get all of the .gcov files from the named directory, including any subdirs
|
|
# If there is a "merge" version of the gcov file, prefer that. These are
|
|
# used when the same source file is compiled for both the MPI and PMPI
|
|
# interfaces,
|
|
sub ExpandDir {
|
|
my $dir = $_[0];
|
|
my @otherdirs = ();
|
|
my @files = ();
|
|
opendir DIR, "$dir";
|
|
for $filename (sort readdir DIR) {
|
|
if ($filename =~ /^\./ || $filename eq ".svn") {
|
|
next;
|
|
}
|
|
elsif (-d "$dir/$filename") {
|
|
# Skip pmpi directories used for merging gcov output
|
|
if ($filename =~ /\-pmpi$/) { next; }
|
|
# Skip mpi directories used for handling name-mangled files
|
|
if ($filename =~ /\-mpi$/) { next; }
|
|
$otherdirs[$#otherdirs+1] = "$dir/$filename";
|
|
}
|
|
elsif ($filename =~ /(.*\.gcov)$/) {
|
|
# Check for the presence of a "merged" gcov file and use instead
|
|
if (-f "$dir/$filename.merge") {
|
|
$files[$#files + 1] = "$dir/$filename.merge";
|
|
}
|
|
else {
|
|
$files[$#files + 1] = "$dir/$filename";
|
|
}
|
|
}
|
|
}
|
|
closedir DIR;
|
|
# (almost) tail recurse on otherdirs (we've closed the directory handle,
|
|
# so we don't need to worry about it anymore)
|
|
foreach $dir (@otherdirs) {
|
|
@files = (@files, &ExpandDir( $dir ) );
|
|
}
|
|
return @files;
|
|
}
|
|
|
|
# --------------------------------------------------------------------------
|
|
# HTMLify
|
|
# Take an input line and make it value HTML
|
|
sub HTMLify {
|
|
my $line = $_[0];
|
|
$line =~ s/\&/--AMP--/g;
|
|
$line =~ s/>/>/g;
|
|
$line =~ s/</</g;
|
|
$line =~ s/--AMP--/&/g;
|
|
return $line;
|
|
}
|
|
|
|
#
|
|
# Output a table of file names
|
|
# OutputFileTable( FD, array-of-names, targethash )
|
|
sub OutputFileTable {
|
|
my $IFD = $_[0];
|
|
my $arrayname = $_[1];
|
|
my $targethashname = $_[2];
|
|
|
|
my $col = 1;
|
|
my $maxcol = 4;
|
|
my $curprefix = "--NONE--";
|
|
for ($i=0; $i<=$#$arrayname; $i++) {
|
|
my $file = $$arrayname[$i];
|
|
my $target = "";
|
|
if ($targethashname ne "") {
|
|
$target = $$targethashname{$file};
|
|
}
|
|
|
|
# Clean up filename
|
|
$file =~ s/^\.\///;
|
|
if ($file =~ /(.*)\/([^\/]*)/) {
|
|
$dirname = $1;
|
|
$basename = $2;
|
|
}
|
|
else {
|
|
$dirname = "";
|
|
$basename = $file;
|
|
}
|
|
|
|
# Clean up target
|
|
if (defined($target) && $target ne "") {
|
|
if ($annoteWebPrefix ne "") {
|
|
$target =~ s/$annoteSrcDir/$annoteWebPrefix/;
|
|
}
|
|
else {
|
|
# make the reference relative
|
|
$target =~ s/$annoteSrcDir\///;
|
|
}
|
|
}
|
|
|
|
# Compare dirname to curprefix; start a new table if
|
|
# necessary
|
|
if ($dirname ne $curprefix) {
|
|
if ($curprefix ne "--NONE--") {
|
|
for (my $j=$col-1; $j<=$maxcol; $j++) {
|
|
print $IFD "<TD></TD>";
|
|
}
|
|
print $IFD "</TR></TABLE>\n";
|
|
}
|
|
$curprefix = $dirname;
|
|
print $IFD "<H2>$dirname</H2>\n";
|
|
print $IFD "<TABLE WIDTH=100%>\n";
|
|
$col = 1;
|
|
}
|
|
if ($col == 1) {
|
|
print $IFD "<TR WIDTH=100%>\n";
|
|
}
|
|
my $label = $basename;
|
|
# my $origFileName = $AnnoteFilesToOrig{$names[$i]};
|
|
my $origFileName = $AnnoteFilesToOrig{$file};
|
|
if (defined($origFileName)) {
|
|
if (defined($AnnoteMissed{$origFileName})) {
|
|
my ($missed,$total) = split(/;/,$AnnoteMissed{$origFileName});
|
|
$label = "$label ($missed)";
|
|
}
|
|
}
|
|
if ($target ne "") {
|
|
print $IFD "<TD><A HREF=\"$target\">$label</A></TD>\n";
|
|
}
|
|
else {
|
|
print $IFD "<TD>$label</TD>\n";
|
|
}
|
|
if ($col++ == $maxcol) {
|
|
print $IFD "</TR>\n";
|
|
$col = 1;
|
|
}
|
|
}
|
|
# Flush the final table
|
|
if ($curprefix ne "--NONE--") {
|
|
# In case the page is empty
|
|
if ($col > 1) {
|
|
for (my $i=$col-1; $i<=$maxcol; $i++) {
|
|
print $IFD "<TD></TD>";
|
|
}
|
|
print $IFD "</TR>\n";
|
|
}
|
|
print $IFD "</TABLE>\n";
|
|
}
|
|
}
|
|
#
|
|
# To generate a summary
|
|
# cd mpich/src
|
|
# ~/projects/mpich/maint/getcoverage mpi/*/*.gcov mpi/romio/mpi-io/*.gcov \
|
|
# mpi/romio/adio/ad_nfs/*.gcov mpi/romio/adio/ad_ufs/*.gcov \
|
|
# util/info/*.gcov \
|
|
# mpid/ch3/src/*.gcov mpid/ch3/channels/sock/src/*.gcov > coverage.txt
|
|
|
|
# Now can use
|
|
# maint/getcoverage src/mpi src/util/info >coveragebase.txt
|
|
# maint/getcoverage src/mpid/ch3/src/*.gcov \
|
|
# src/mpid/ch3/channels/sock/src/*.gcov > coveragempid.txt
|
|
|
|
#
|
|
# Skip over a named block (while writing it to the annotation file)
|
|
# Usage:
|
|
# skipBlockAndAnnotate( outfd, blockname );
|
|
# e.g.,
|
|
# skipBlockAndAnnotate( $outfile, "DEBUG" );
|
|
sub skipBlockAndAnnotate {
|
|
my ($outfile,$blockName) = @_;
|
|
|
|
my $sawend=0;
|
|
print STDERR "Skipping BEGIN $blockName\n" if $gDebugDetail;
|
|
while (<FD>) {
|
|
if (/^\s/) { print $outfile &HTMLify($_); }
|
|
if (/^$lineLeader2\/\*\s+--END $blockName--\s+\*\// ||
|
|
/^$lineLeader3\/\*\s+--END $blockName--\s+\*\// ||
|
|
/^$lineLeader4\/\*\s+--END $blockName--\s+\*\//) {
|
|
$sawend = 1;
|
|
last;
|
|
}
|
|
}
|
|
if (!$sawend) {
|
|
print STDERR "File $gFilename ended in --BEGIN $blockName-- block\n";
|
|
}
|
|
}
|
|
|
|
# Skip over a named block. Return the number of lines skipped
|
|
# Usage:
|
|
# skipBlock( blockname, allowNested, linecount )
|
|
# e.g.,
|
|
# skipBlock( "DEBUG", 0, linecount );
|
|
sub skipBlock {
|
|
my ($blockName,$allowNested,$linecount) = @_;
|
|
my $fileline = 0;
|
|
my $lineincr = 0;
|
|
|
|
while (<FD>) {
|
|
$lineincr++;
|
|
if (/^\s/) { $fileline++; }
|
|
if (! $allowNested) {
|
|
if (/^$lineLeader2\/\*\s+--BEGIN/ ||
|
|
/^$lineLeader3\/\*\s+--BEGIN/ ||
|
|
/^$lineLeader4\/\*\s+--BEGIN/) {
|
|
my $cleanline = $_;
|
|
$cleanline =~ s/^\s*//;
|
|
chop $cleanline;
|
|
my $curlinecount = $linecount + $lineincr;
|
|
print STDERR "Possible missing END $blockName in $gFilename at $curlinecount; saw $cleanline\n";
|
|
}
|
|
}
|
|
# else {
|
|
# if (/^\s*\/\*\s*--\s*END\s+$blockName\s*--\s*\*\/\s*/ ||
|
|
# /^\s*-:\s*\d+:\s*\/\*\s*--\s*END\s+$blockName\s*--\s*\*\/\s*/) {
|
|
# # FIXME: Why is this a mangled line? Should some of the \s* be
|
|
# # \s+? (e.g., --\s+END)
|
|
# my $curlinecount = $linecount + $lineincr;
|
|
# print STDERR "Mangled line in $gFilename at $curlinecount: $_";
|
|
# last;
|
|
# }
|
|
# }
|
|
if (/^$lineLeader2\/\*\s+--END $blockName--\s+\*\// ||
|
|
/^$lineLeader3\/\*\s+--END $blockName--\s+\*\// ||
|
|
/^$lineLeader4\/\*\s+--END $blockName--\s+\*\//) {
|
|
last;
|
|
}
|
|
# If we match the following but not the preceding, there are extra
|
|
# spaces in the comment
|
|
if (/^\s*\/\*\s*--\s*END\s+$blockName\s*--\s*\*\/\s*/ ||
|
|
/^\s*-:\s*\d+:\s*\/\*\s*--\s*END\s+$blockName\s*--\s*\*\/\s*/) {
|
|
my $curlinecount = $linecount + $lineincr;
|
|
print STDERR "Mangled line in $gFilename at $curlinecount: $_";
|
|
last;
|
|
}
|
|
}
|
|
return ($lineincr,$fileline);
|
|
}
|
|
|
|
#
|
|
# skipIfdefBlock
|
|
# (ToDo)
|