blob: 055641baccb7ac65ab8b8eaa62a20e3a3e33957a [file] [log] [blame]
#!/usr/bin/perl -w
#
# Copyright (c) International Business Machines Corp., 2002,2007
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#
# geninfo
#
# This script generates .info files from data files as created by code
# instrumented with gcc's built-in profiling mechanism. Call it with
# --help and refer to the geninfo man page to get information on usage
# and available options.
#
#
# Authors:
# 2002-08-23 created by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com>
# IBM Lab Boeblingen
# based on code by Manoj Iyer <manjo@mail.utexas.edu> and
# Megan Bock <mbock@us.ibm.com>
# IBM Austin
# 2002-09-05 / Peter Oberparleiter: implemented option that allows file list
# 2003-04-16 / Peter Oberparleiter: modified read_gcov so that it can also
# parse the new gcov format which is to be introduced in gcc 3.3
# 2003-04-30 / Peter Oberparleiter: made info write to STDERR, not STDOUT
# 2003-07-03 / Peter Oberparleiter: added line checksum support, added
# --no-checksum
# 2003-09-18 / Nigel Hinds: capture branch coverage data from GCOV
# 2003-12-11 / Laurent Deniel: added --follow option
# workaround gcov (<= 3.2.x) bug with empty .da files
# 2004-01-03 / Laurent Deniel: Ignore empty .bb files
# 2004-02-16 / Andreas Krebbel: Added support for .gcno/.gcda files and
# gcov versioning
# 2004-08-09 / Peter Oberparleiter: added configuration file support
# 2008-07-14 / Tom Zoerner: added --function-coverage command line option
# 2008-08-13 / Peter Oberparleiter: modified function coverage
# implementation (now enabled per default)
#
use strict;
use File::Basename;
use Getopt::Long;
use Digest::MD5 qw(md5_base64);
# Constants
our $lcov_version = "LCOV version 1.7";
our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php";
our $gcov_tool = "gcov";
our $tool_name = basename($0);
our $GCOV_VERSION_3_4_0 = 0x30400;
our $GCOV_VERSION_3_3_0 = 0x30300;
our $GCNO_FUNCTION_TAG = 0x01000000;
our $GCNO_LINES_TAG = 0x01450000;
our $GCNO_FILE_MAGIC = 0x67636e6f;
our $BBG_FILE_MAGIC = 0x67626267;
our $COMPAT_HAMMER = "hammer";
our $ERROR_GCOV = 0;
our $ERROR_SOURCE = 1;
# Prototypes
sub print_usage(*);
sub gen_info($);
sub process_dafile($);
sub match_filename($@);
sub solve_ambiguous_match($$$);
sub split_filename($);
sub solve_relative_path($$);
sub get_dir($);
sub read_gcov_header($);
sub read_gcov_file($);
sub read_bb_file($$);
sub read_string(*$);
sub read_gcno_file($$);
sub read_gcno_string(*$);
sub read_hammer_bbg_file($$);
sub read_hammer_bbg_string(*$);
sub unpack_int32($$);
sub info(@);
sub get_gcov_version();
sub system_no_output($@);
sub read_config($);
sub apply_config($);
sub gen_initial_info($);
sub process_graphfile($);
sub warn_handler($);
sub die_handler($);
# Global variables
our $gcov_version;
our $graph_file_extension;
our $data_file_extension;
our @data_directory;
our $test_name = "";
our $quiet;
our $help;
our $output_filename;
our $base_directory;
our $version;
our $follow;
our $checksum;
our $no_checksum;
our $preserve_paths;
our $compat_libtool;
our $no_compat_libtool;
our $adjust_testname;
our $config; # Configuration file contents
our $compatibility; # Compatibility version flag - used to indicate
# non-standard GCOV data format versions
our @ignore_errors; # List of errors to ignore (parameter)
our @ignore; # List of errors to ignore (array)
our $initial;
our $no_recursion = 0;
our $maxdepth;
our $cwd = `pwd`;
chomp($cwd);
#
# Code entry point
#
# Register handler routine to be called when interrupted
$SIG{"INT"} = \&int_handler;
$SIG{__WARN__} = \&warn_handler;
$SIG{__DIE__} = \&die_handler;
# Read configuration file if available
if (-r $ENV{"HOME"}."/.lcovrc")
{
$config = read_config($ENV{"HOME"}."/.lcovrc");
}
elsif (-r "/etc/lcovrc")
{
$config = read_config("/etc/lcovrc");
}
if ($config)
{
# Copy configuration file values to variables
apply_config({
"geninfo_gcov_tool" => \$gcov_tool,
"geninfo_adjust_testname" => \$adjust_testname,
"geninfo_checksum" => \$checksum,
"geninfo_no_checksum" => \$no_checksum, # deprecated
"geninfo_compat_libtool" => \$compat_libtool});
# Merge options
if (defined($no_checksum))
{
$checksum = ($no_checksum ? 0 : 1);
$no_checksum = undef;
}
}
# Parse command line options
if (!GetOptions("test-name=s" => \$test_name,
"output-filename=s" => \$output_filename,
"checksum" => \$checksum,
"no-checksum" => \$no_checksum,
"base-directory=s" => \$base_directory,
"version" =>\$version,
"quiet" => \$quiet,
"help|?" => \$help,
"follow" => \$follow,
"compat-libtool" => \$compat_libtool,
"no-compat-libtool" => \$no_compat_libtool,
"gcov-tool=s" => \$gcov_tool,
"ignore-errors=s" => \@ignore_errors,
"initial|i" => \$initial,
"no-recursion" => \$no_recursion,
))
{
print(STDERR "Use $tool_name --help to get usage information\n");
exit(1);
}
else
{
# Merge options
if (defined($no_checksum))
{
$checksum = ($no_checksum ? 0 : 1);
$no_checksum = undef;
}
if (defined($no_compat_libtool))
{
$compat_libtool = ($no_compat_libtool ? 0 : 1);
$no_compat_libtool = undef;
}
}
@data_directory = @ARGV;
# Check for help option
if ($help)
{
print_usage(*STDOUT);
exit(0);
}
# Check for version option
if ($version)
{
print("$tool_name: $lcov_version\n");
exit(0);
}
# Make sure test names only contain valid characters
if ($test_name =~ s/\W/_/g)
{
warn("WARNING: invalid characters removed from testname!\n");
}
# Adjust test name to include uname output if requested
if ($adjust_testname)
{
$test_name .= "__".`uname -a`;
$test_name =~ s/\W/_/g;
}
# Make sure base_directory contains an absolute path specification
if ($base_directory)
{
$base_directory = solve_relative_path($cwd, $base_directory);
}
# Check for follow option
if ($follow)
{
$follow = "-follow"
}
else
{
$follow = "";
}
# Determine checksum mode
if (defined($checksum))
{
# Normalize to boolean
$checksum = ($checksum ? 1 : 0);
}
else
{
# Default is off
$checksum = 0;
}
# Determine libtool compatibility mode
if (defined($compat_libtool))
{
$compat_libtool = ($compat_libtool? 1 : 0);
}
else
{
# Default is on
$compat_libtool = 1;
}
# Determine max depth for recursion
if ($no_recursion)
{
$maxdepth = "-maxdepth 1";
}
else
{
$maxdepth = "";
}
# Check for directory name
if (!@data_directory)
{
die("No directory specified\n".
"Use $tool_name --help to get usage information\n");
}
else
{
foreach (@data_directory)
{
stat($_);
if (!-r _)
{
die("ERROR: cannot read $_!\n");
}
}
}
if (@ignore_errors)
{
my @expanded;
my $error;
# Expand comma-separated entries
foreach (@ignore_errors) {
if (/,/)
{
push(@expanded, split(",", $_));
}
else
{
push(@expanded, $_);
}
}
foreach (@expanded)
{
/^gcov$/ && do { $ignore[$ERROR_GCOV] = 1; next; } ;
/^source$/ && do { $ignore[$ERROR_SOURCE] = 1; next; };
die("ERROR: unknown argument for --ignore-errors: $_\n");
}
}
if (system_no_output(3, $gcov_tool, "--help") == -1)
{
die("ERROR: need tool $gcov_tool!\n");
}
$gcov_version = get_gcov_version();
if ($gcov_version < $GCOV_VERSION_3_4_0)
{
if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER)
{
$data_file_extension = ".da";
$graph_file_extension = ".bbg";
}
else
{
$data_file_extension = ".da";
$graph_file_extension = ".bb";
}
}
else
{
$data_file_extension = ".gcda";
$graph_file_extension = ".gcno";
}
# Check for availability of --preserve-paths option of gcov
if (`$gcov_tool --help` =~ /--preserve-paths/)
{
$preserve_paths = "--preserve-paths";
}
# Check output filename
if (defined($output_filename) && ($output_filename ne "-"))
{
# Initially create output filename, data is appended
# for each data file processed
local *DUMMY_HANDLE;
open(DUMMY_HANDLE, ">$output_filename")
or die("ERROR: cannot create $output_filename!\n");
close(DUMMY_HANDLE);
# Make $output_filename an absolute path because we're going
# to change directories while processing files
if (!($output_filename =~ /^\/(.*)$/))
{
$output_filename = $cwd."/".$output_filename;
}
}
# Do something
if ($initial)
{
foreach (@data_directory)
{
gen_initial_info($_);
}
}
else
{
foreach (@data_directory)
{
gen_info($_);
}
}
info("Finished .info-file creation\n");
exit(0);
#
# print_usage(handle)
#
# Print usage information.
#
sub print_usage(*)
{
local *HANDLE = $_[0];
print(HANDLE <<END_OF_USAGE);
Usage: $tool_name [OPTIONS] DIRECTORY
Traverse DIRECTORY and create a .info file for each data file found. Note
that you may specify more than one directory, all of which are then processed
sequentially.
-h, --help Print this help, then exit
-v, --version Print version number, then exit
-q, --quiet Do not print progress messages
-i, --initial Capture initial zero coverage data
-t, --test-name NAME Use test case name NAME for resulting data
-o, --output-filename OUTFILE Write data only to OUTFILE
-f, --follow Follow links when searching .da/.gcda files
-b, --base-directory DIR Use DIR as base directory for relative paths
--(no-)checksum Enable (disable) line checksumming
--(no-)compat-libtool Enable (disable) libtool compatibility mode
--gcov-tool TOOL Specify gcov tool location
--ignore-errors ERROR Continue after ERROR (gcov, source)
--no-recursion Exlude subdirectories from processing
--function-coverage Capture function call counts
For more information see: $lcov_url
END_OF_USAGE
;
}
#
# gen_info(directory)
#
# Traverse DIRECTORY and create a .info file for each data file found.
# The .info file contains TEST_NAME in the following format:
#
# TN:<test name>
#
# For each source file name referenced in the data file, there is a section
# containing source code and coverage data:
#
# SF:<absolute path to the source file>
# FN:<line number of function start>,<function name> for each function
# DA:<line number>,<execution count> for each instrumented line
# LH:<number of lines with an execution count> greater than 0
# LF:<number of instrumented lines>
#
# Sections are separated by:
#
# end_of_record
#
# In addition to the main source code file there are sections for each
# #included file containing executable code. Note that the absolute path
# of a source file is generated by interpreting the contents of the respective
# graph file. Relative filenames are prefixed with the directory in which the
# graph file is found. Note also that symbolic links to the graph file will be
# resolved so that the actual file path is used instead of the path to a link.
# This approach is necessary for the mechanism to work with the /proc/gcov
# files.
#
# Die on error.
#
sub gen_info($)
{
my $directory = $_[0];
my @file_list;
if (-d $directory)
{
info("Scanning $directory for $data_file_extension ".
"files ...\n");
@file_list = `find "$directory" $maxdepth $follow -name \\*$data_file_extension -type f 2>/dev/null`;
chomp(@file_list);
@file_list or die("ERROR: no $data_file_extension files found ".
"in $directory!\n");
info("Found %d data files in %s\n", $#file_list+1, $directory);
}
else
{
@file_list = ($directory);
}
# Process all files in list
foreach (@file_list) { process_dafile($_); }
}
#
# process_dafile(da_filename)
#
# Create a .info file for a single data file.
#
# Die on error.
#
sub process_dafile($)
{
info("Processing %s\n", $_[0]);
my $da_filename; # Name of data file to process
my $da_dir; # Directory of data file
my $source_dir; # Directory of source file
my $da_basename; # data filename without ".da/.gcda" extension
my $bb_filename; # Name of respective graph file
my %bb_content; # Contents of graph file
my $gcov_error; # Error code of gcov tool
my $object_dir; # Directory containing all object files
my $source_filename; # Name of a source code file
my $gcov_file; # Name of a .gcov file
my @gcov_content; # Content of a .gcov file
my @gcov_branches; # Branch content of a .gcov file
my @gcov_functions; # Function calls of a .gcov file
my @gcov_list; # List of generated .gcov files
my $line_number; # Line number count
my $lines_hit; # Number of instrumented lines hit
my $lines_found; # Number of instrumented lines found
my $funcs_hit; # Number of instrumented functions hit
my $funcs_found; # Number of instrumented functions found
my $source; # gcov source header information
my $object; # gcov object header information
my @matches; # List of absolute paths matching filename
my @unprocessed; # List of unprocessed source code files
my $base_dir; # Base directory for current file
my @result;
my $index;
my $da_renamed; # If data file is to be renamed
local *INFO_HANDLE;
# Get path to data file in absolute and normalized form (begins with /,
# contains no more ../ or ./)
$da_filename = solve_relative_path($cwd, $_[0]);
# Get directory and basename of data file
($da_dir, $da_basename) = split_filename($da_filename);
# avoid files from .libs dirs
if ($compat_libtool && $da_dir =~ m/(.*)\/\.libs$/) {
$source_dir = $1;
} else {
$source_dir = $da_dir;
}
if (-z $da_filename)
{
$da_renamed = 1;
}
else
{
$da_renamed = 0;
}
# Construct base_dir for current file
if ($base_directory)
{
$base_dir = $base_directory;
}
else
{
$base_dir = $source_dir;
}
# Check for writable $base_dir (gcov will try to write files there)
stat($base_dir);
if (!-w _)
{
die("ERROR: cannot write to directory $base_dir!\n");
}
# Construct name of graph file
$bb_filename = $da_dir."/".$da_basename.$graph_file_extension;
# Find out the real location of graph file in case we're just looking at
# a link
while (readlink($bb_filename))
{
my $last_dir = dirname($bb_filename);
$bb_filename = readlink($bb_filename);
$bb_filename = solve_relative_path($last_dir, $bb_filename);
}
# Ignore empty graph file (e.g. source file with no statement)
if (-z $bb_filename)
{
warn("WARNING: empty $bb_filename (skipped)\n");
return;
}
# Read contents of graph file into hash. We need it later to find out
# the absolute path to each .gcov file created as well as for
# information about functions and their source code positions.
if ($gcov_version < $GCOV_VERSION_3_4_0)
{
if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER)
{
%bb_content = read_hammer_bbg_file($bb_filename,
$base_dir);
}
else
{
%bb_content = read_bb_file($bb_filename, $base_dir);
}
}
else
{
%bb_content = read_gcno_file($bb_filename, $base_dir);
}
# Set $object_dir to real location of object files. This may differ
# from $da_dir if the graph file is just a link to the "real" object
# file location.
$object_dir = dirname($bb_filename);
# Is the data file in a different directory? (this happens e.g. with
# the gcov-kernel patch)
if ($object_dir ne $da_dir)
{
# Need to create link to data file in $object_dir
system("ln", "-s", $da_filename,
"$object_dir/$da_basename$data_file_extension")
and die ("ERROR: cannot create link $object_dir/".
"$da_basename$data_file_extension!\n");
}
# Change to directory containing data files and apply GCOV
chdir($base_dir);
if ($da_renamed)
{
# Need to rename empty data file to workaround
# gcov <= 3.2.x bug (Abort)
system_no_output(3, "mv", "$da_filename", "$da_filename.ori")
and die ("ERROR: cannot rename $da_filename\n");
}
# Execute gcov command and suppress standard output
if ($preserve_paths)
{
$gcov_error = system_no_output(1, $gcov_tool, $da_filename,
"-o", $object_dir,
"--preserve-paths",
"-b");
}
else
{
$gcov_error = system_no_output(1, $gcov_tool, $da_filename,
"-o", $object_dir,
"-b");
}
if ($da_renamed)
{
system_no_output(3, "mv", "$da_filename.ori", "$da_filename")
and die ("ERROR: cannot rename $da_filename.ori");
}
# Clean up link
if ($object_dir ne $da_dir)
{
unlink($object_dir."/".$da_basename.$data_file_extension);
}
if ($gcov_error)
{
if ($ignore[$ERROR_GCOV])
{
warn("WARNING: GCOV failed for $da_filename!\n");
return;
}
die("ERROR: GCOV failed for $da_filename!\n");
}
# Collect data from resulting .gcov files and create .info file
@gcov_list = glob("*.gcov");
# Check for files
if (!@gcov_list)
{
warn("WARNING: gcov did not create any files for ".
"$da_filename!\n");
}
# Check whether we're writing to a single file
if ($output_filename)
{
if ($output_filename eq "-")
{
*INFO_HANDLE = *STDOUT;
}
else
{
# Append to output file
open(INFO_HANDLE, ">>$output_filename")
or die("ERROR: cannot write to ".
"$output_filename!\n");
}
}
else
{
# Open .info file for output
open(INFO_HANDLE, ">$da_filename.info")
or die("ERROR: cannot create $da_filename.info!\n");
}
# Write test name
printf(INFO_HANDLE "TN:%s\n", $test_name);
# Traverse the list of generated .gcov files and combine them into a
# single .info file
@unprocessed = keys(%bb_content);
foreach $gcov_file (@gcov_list)
{
($source, $object) = read_gcov_header($gcov_file);
if (defined($source))
{
$source = solve_relative_path($base_dir, $source);
}
# gcov will happily create output even if there's no source code
# available - this interferes with checksum creation so we need
# to pull the emergency brake here.
if (defined($source) && ! -r $source && $checksum)
{
if ($ignore[$ERROR_SOURCE])
{
warn("WARNING: could not read source file ".
"$source\n");
next;
}
die("ERROR: could not read source file $source\n");
}
@matches = match_filename(defined($source) ? $source :
$gcov_file, keys(%bb_content));
# Skip files that are not mentioned in the graph file
if (!@matches)
{
warn("WARNING: cannot find an entry for ".$gcov_file.
" in $graph_file_extension file, skipping ".
"file!\n");
unlink($gcov_file);
next;
}
# Read in contents of gcov file
@result = read_gcov_file($gcov_file);
@gcov_content = @{$result[0]};
@gcov_branches = @{$result[1]};
@gcov_functions = @{$result[2]};
# Skip empty files
if (!@gcov_content)
{
warn("WARNING: skipping empty file ".$gcov_file."\n");
unlink($gcov_file);
next;
}
if (scalar(@matches) == 1)
{
# Just one match
$source_filename = $matches[0];
}
else
{
# Try to solve the ambiguity
$source_filename = solve_ambiguous_match($gcov_file,
\@matches, \@gcov_content);
}
# Remove processed file from list
for ($index = scalar(@unprocessed) - 1; $index >= 0; $index--)
{
if ($unprocessed[$index] eq $source_filename)
{
splice(@unprocessed, $index, 1);
last;
}
}
# Write absolute path of source file
printf(INFO_HANDLE "SF:%s\n", $source_filename);
# Write function-related information
if (defined($bb_content{$source_filename}))
{
foreach (split(",",$bb_content{$source_filename}))
{
my ($fn, $line) = split("=", $_);
if ($fn eq "") {
next;
}
# Normalize function name
$fn =~ s/\W/_/g;
print(INFO_HANDLE "FN:$line,$fn\n");
}
}
#--
#-- FNDA: <call-count>, <function-name>
#-- FNF: overall count of functions
#-- FNH: overall count of functions with non-zero call count
#--
$funcs_found = 0;
$funcs_hit = 0;
while (@gcov_functions)
{
printf(INFO_HANDLE "FNDA:%s,%s\n",
$gcov_functions[0],
$gcov_functions[1]);
$funcs_found++;
$funcs_hit++ if $gcov_functions[0];
splice(@gcov_functions,0,2);
}
if ($funcs_found > 0) {
printf(INFO_HANDLE "FNF:%s\n", $funcs_found);
printf(INFO_HANDLE "FNH:%s\n", $funcs_hit);
}
# Reset line counters
$line_number = 0;
$lines_found = 0;
$lines_hit = 0;
# Write coverage information for each instrumented line
# Note: @gcov_content contains a list of (flag, count, source)
# tuple for each source code line
while (@gcov_content)
{
$line_number++;
# Check for instrumented line
if ($gcov_content[0])
{
$lines_found++;
printf(INFO_HANDLE "DA:".$line_number.",".
$gcov_content[1].($checksum ?
",". md5_base64($gcov_content[2]) : "").
"\n");
# Increase $lines_hit in case of an execution
# count>0
if ($gcov_content[1] > 0) { $lines_hit++; }
}
# Remove already processed data from array
splice(@gcov_content,0,3);
}
#--
#-- BA: <code-line>, <branch-coverage>
#--
#-- print one BA line for every branch of a
#-- conditional. <branch-coverage> values
#-- are:
#-- 0 - not executed
#-- 1 - executed but not taken
#-- 2 - executed and taken
#--
while (@gcov_branches)
{
if ($gcov_branches[0])
{
printf(INFO_HANDLE "BA:%s,%s\n",
$gcov_branches[0],
$gcov_branches[1]);
}
splice(@gcov_branches,0,2);
}
# Write line statistics and section separator
printf(INFO_HANDLE "LF:%s\n", $lines_found);
printf(INFO_HANDLE "LH:%s\n", $lines_hit);
print(INFO_HANDLE "end_of_record\n");
# Remove .gcov file after processing
unlink($gcov_file);
}
# Check for files which show up in the graph file but were never
# processed
if (@unprocessed && @gcov_list)
{
foreach (@unprocessed)
{
warn("WARNING: no data found for $_\n");
}
}
if (!($output_filename && ($output_filename eq "-")))
{
close(INFO_HANDLE);
}
# Change back to initial directory
chdir($cwd);
}
#
# solve_relative_path(path, dir)
#
# Solve relative path components of DIR which, if not absolute, resides in PATH.
#
sub solve_relative_path($$)
{
my $path = $_[0];
my $dir = $_[1];
my $result;
$result = $dir;
# Prepend path if not absolute
if ($dir =~ /^[^\/]/)
{
$result = "$path/$result";
}
# Remove //
$result =~ s/\/\//\//g;
# Remove .
$result =~ s/\/\.\//\//g;
# Solve ..
while ($result =~ s/\/[^\/]+\/\.\.\//\//)
{
}
# Remove preceding ..
$result =~ s/^\/\.\.\//\//g;
return $result;
}
#
# match_filename(gcov_filename, list)
#
# Return a list of those entries of LIST which match the relative filename
# GCOV_FILENAME.
#
sub match_filename($@)
{
my $filename = shift;
my @list = @_;
my @result;
$filename =~ s/^(.*).gcov$/$1/;
if ($filename =~ /^\/(.*)$/)
{
$filename = "$1";
}
foreach (@list)
{
if (/\/\Q$filename\E(.*)$/ && $1 eq "")
{
@result = (@result, $_);
}
}
return @result;
}
#
# solve_ambiguous_match(rel_filename, matches_ref, gcov_content_ref)
#
# Try to solve ambiguous matches of mapping (gcov file) -> (source code) file
# by comparing source code provided in the GCOV file with that of the files
# in MATCHES. REL_FILENAME identifies the relative filename of the gcov
# file.
#
# Return the one real match or die if there is none.
#
sub solve_ambiguous_match($$$)
{
my $rel_name = $_[0];
my $matches = $_[1];
my $content = $_[2];
my $filename;
my $index;
my $no_match;
local *SOURCE;
# Check the list of matches
foreach $filename (@$matches)
{
# Compare file contents
open(SOURCE, $filename)
or die("ERROR: cannot read $filename!\n");
$no_match = 0;
for ($index = 2; <SOURCE>; $index += 3)
{
chomp;
if ($_ ne @$content[$index])
{
$no_match = 1;
last;
}
}
close(SOURCE);
if (!$no_match)
{
info("Solved source file ambiguity for $rel_name\n");
return $filename;
}
}
die("ERROR: could not match gcov data for $rel_name!\n");
}
#
# split_filename(filename)
#
# Return (path, filename, extension) for a given FILENAME.
#
sub split_filename($)
{
my @path_components = split('/', $_[0]);
my @file_components = split('\.', pop(@path_components));
my $extension = pop(@file_components);
return (join("/",@path_components), join(".",@file_components),
$extension);
}
#
# get_dir(filename);
#
# Return the directory component of a given FILENAME.
#
sub get_dir($)
{
my @components = split("/", $_[0]);
pop(@components);
return join("/", @components);
}
#
# read_gcov_header(gcov_filename)
#
# Parse file GCOV_FILENAME and return a list containing the following
# information:
#
# (source, object)
#
# where:
#
# source: complete relative path of the source code file (gcc >= 3.3 only)
# object: name of associated graph file
#
# Die on error.
#
sub read_gcov_header($)
{
my $source;
my $object;
local *INPUT;
if (!open(INPUT, $_[0]))
{
if ($ignore_errors[$ERROR_GCOV])
{
warn("WARNING: cannot read $_[0]!\n");
return (undef,undef);
}
die("ERROR: cannot read $_[0]!\n");
}
while (<INPUT>)
{
chomp($_);
if (/^\s+-:\s+0:Source:(.*)$/)
{
# Source: header entry
$source = $1;
}
elsif (/^\s+-:\s+0:Object:(.*)$/)
{
# Object: header entry
$object = $1;
}
else
{
last;
}
}
close(INPUT);
return ($source, $object);
}
#
# read_gcov_file(gcov_filename)
#
# Parse file GCOV_FILENAME (.gcov file format) and return the list:
# (reference to gcov_content, reference to gcov_branch, reference to gcov_func)
#
# gcov_content is a list of 3 elements
# (flag, count, source) for each source code line:
#
# $result[($line_number-1)*3+0] = instrumentation flag for line $line_number
# $result[($line_number-1)*3+1] = execution count for line $line_number
# $result[($line_number-1)*3+2] = source code text for line $line_number
#
# gcov_branch is a list of 2 elements
# (linenumber, branch result) for each branch
#
# gcov_func is a list of 2 elements
# (number of calls, function name) for each function
#
# Die on error.
#
sub read_gcov_file($)
{
my $filename = $_[0];
my @result = ();
my @branches = ();
my @functions = ();
my $number;
local *INPUT;
open(INPUT, $filename)
or die("ERROR: cannot read $filename!\n");
if ($gcov_version < $GCOV_VERSION_3_3_0)
{
# Expect gcov format as used in gcc < 3.3
while (<INPUT>)
{
chomp($_);
if (/^\t\t(.*)$/)
{
# Uninstrumented line
push(@result, 0);
push(@result, 0);
push(@result, $1);
}
elsif (/^branch/)
{
# Branch execution data
push(@branches, scalar(@result) / 3);
if (/^branch \d+ never executed$/)
{
push(@branches, 0);
}
elsif (/^branch \d+ taken = 0%/)
{
push(@branches, 1);
}
else
{
push(@branches, 2);
}
}
elsif (/^call/ || /^function/)
{
# Function call return data
}
else
{
# Source code execution data
$number = (split(" ",substr($_, 0, 16)))[0];
# Check for zero count which is indicated
# by ######
if ($number eq "######") { $number = 0; }
push(@result, 1);
push(@result, $number);
push(@result, substr($_, 16));
}
}
}
else
{
# Expect gcov format as used in gcc >= 3.3
while (<INPUT>)
{
chomp($_);
if (/^branch\s+\d+\s+(\S+)\s+(\S+)/)
{
# Branch execution data
push(@branches, scalar(@result) / 3);
if ($1 eq "never")
{
push(@branches, 0);
}
elsif ($2 eq "0%")
{
push(@branches, 1);
}
else
{
push(@branches, 2);
}
}
elsif (/^function\s+(\S+)\s+called\s+(\d+)/)
{
push(@functions, $2, $1);
}
elsif (/^call/)
{
# Function call return data
}
elsif (/^\s*([^:]+):\s*([^:]+):(.*)$/)
{
# <exec count>:<line number>:<source code>
if ($2 eq "0")
{
# Extra data
}
elsif ($1 eq "-")
{
# Uninstrumented line
push(@result, 0);
push(@result, 0);
push(@result, $3);
}
else
{
# Source code execution data
$number = $1;
# Check for zero count
if ($number eq "#####") { $number = 0; }
push(@result, 1);
push(@result, $number);
push(@result, $3);
}
}
}
}
close(INPUT);
return(\@result, \@branches, \@functions);
}
#
# read_bb_file(bb_filename, base_dir)
#
# Read .bb file BB_FILENAME and return a hash containing the following
# mapping:
#
# filename -> comma-separated list of pairs (function name=starting
# line number) to indicate the starting line of a function or
# =name to indicate an instrumented line
#
# for each entry in the .bb file. Filenames are absolute, i.e. relative
# filenames are prefixed with BASE_DIR.
#
# Die on error.
#
sub read_bb_file($$)
{
my $bb_filename = $_[0];
my $base_dir = $_[1];
my %result;
my $filename;
my $function_name;
my $minus_one = sprintf("%d", 0x80000001);
my $minus_two = sprintf("%d", 0x80000002);
my $value;
my $packed_word;
local *INPUT;
open(INPUT, $bb_filename)
or die("ERROR: cannot read $bb_filename!\n");
binmode(INPUT);
# Read data in words of 4 bytes
while (read(INPUT, $packed_word, 4) == 4)
{
# Decode integer in intel byteorder
$value = unpack_int32($packed_word, 0);
# Note: the .bb file format is documented in GCC info pages
if ($value == $minus_one)
{
# Filename follows
$filename = read_string(*INPUT, $minus_one)
or die("ERROR: incomplete filename in ".
"$bb_filename!\n");
# Make path absolute
$filename = solve_relative_path($base_dir, $filename);
# Insert into hash if not yet present.
# This is necessary because functions declared as
# "inline" are not listed as actual functions in
# .bb files
if (!$result{$filename})
{
$result{$filename}="";
}
}
elsif ($value == $minus_two)
{
# Function name follows
$function_name = read_string(*INPUT, $minus_two)
or die("ERROR: incomplete function ".
"name in $bb_filename!\n");
$function_name =~ s/\W/_/g;
}
elsif ($value > 0)
{
if (defined($filename))
{
$result{$filename} .=
($result{$filename} ? "," : "").
"=$value";
}
else
{
warn("WARNING: unassigned line".
" number in .bb file ".
"$bb_filename\n");
}
if ($function_name)
{
# Got a full entry filename, funcname, lineno
# Add to resulting hash
$result{$filename}.=
($result{$filename} ? "," : "").
join("=",($function_name,$value));
undef($function_name);
}
}
}
close(INPUT);
if (!scalar(keys(%result)))
{
die("ERROR: no data found in $bb_filename!\n");
}
return %result;
}
#
# read_string(handle, delimiter);
#
# Read and return a string in 4-byte chunks from HANDLE until DELIMITER
# is found.
#
# Return empty string on error.
#
sub read_string(*$)
{
my $HANDLE = $_[0];
my $delimiter = $_[1];
my $string = "";
my $packed_word;
my $value;
while (read($HANDLE,$packed_word,4) == 4)
{
$value = unpack_int32($packed_word, 0);
if ($value == $delimiter)
{
# Remove trailing nil bytes
$/="\0";
while (chomp($string)) {};
$/="\n";
return($string);
}
$string = $string.$packed_word;
}
return("");
}
#
# read_gcno_file(bb_filename, base_dir)
#
# Read .gcno file BB_FILENAME and return a hash containing the following
# mapping:
#
# filename -> comma-separated list of pairs (function name=starting
# line number) to indicate the starting line of a function or
# =name to indicate an instrumented line
#
# for each entry in the .gcno file. Filenames are absolute, i.e. relative
# filenames are prefixed with BASE_DIR.
#
# Die on error.
#
sub read_gcno_file($$)
{
my $gcno_filename = $_[0];
my $base_dir = $_[1];
my %result;
my $filename;
my $function_name;
my $lineno;
my $length;
my $value;
my $endianness;
my $blocks;
my $packed_word;
my $string;
local *INPUT;
open(INPUT, $gcno_filename)
or die("ERROR: cannot read $gcno_filename!\n");
binmode(INPUT);
read(INPUT, $packed_word, 4) == 4
or die("ERROR: Invalid gcno file format\n");
$value = unpack_int32($packed_word, 0);
$endianness = !($value == $GCNO_FILE_MAGIC);
unpack_int32($packed_word, $endianness) == $GCNO_FILE_MAGIC
or die("ERROR: gcno file magic does not match\n");
seek(INPUT, 8, 1);
# Read data in words of 4 bytes
while (read(INPUT, $packed_word, 4) == 4)
{
# Decode integer in intel byteorder
$value = unpack_int32($packed_word, $endianness);
if ($value == $GCNO_FUNCTION_TAG)
{
# skip length, ident and checksum
seek(INPUT, 12, 1);
(undef, $function_name) =
read_gcno_string(*INPUT, $endianness);
$function_name =~ s/\W/_/g;
(undef, $filename) =
read_gcno_string(*INPUT, $endianness);
$filename = solve_relative_path($base_dir, $filename);
read(INPUT, $packed_word, 4);
$lineno = unpack_int32($packed_word, $endianness);
$result{$filename}.=
($result{$filename} ? "," : "").
join("=",($function_name,$lineno));
}
elsif ($value == $GCNO_LINES_TAG)
{
# Check for names of files containing inlined code
# included in this file
read(INPUT, $packed_word, 4);
$length = unpack_int32($packed_word, $endianness);
if ($length > 0)
{
# Block number
read(INPUT, $packed_word, 4);
$length--;
}
while ($length > 0)
{
read(INPUT, $packed_word, 4);
$lineno = unpack_int32($packed_word,
$endianness);
$length--;
if ($lineno != 0)
{
if (defined($filename))
{
$result{$filename} .=
($result{$filename} ? "," : "").
"=$lineno";
}
else
{
warn("WARNING: unassigned line".
" number in .gcno file ".
"$gcno_filename\n");
}
next;
}
last if ($length == 0);
($blocks, $string) =
read_gcno_string(*INPUT, $endianness);
if (defined($string))
{
$filename = $string;
}
if ($blocks > 1)
{
$filename = solve_relative_path(
$base_dir, $filename);
if (!defined($result{$filename}))
{
$result{$filename} = "";
}
}
$length -= $blocks;
}
}
else
{
read(INPUT, $packed_word, 4);
$length = unpack_int32($packed_word, $endianness);
seek(INPUT, 4 * $length, 1);
}
}
close(INPUT);
if (!scalar(keys(%result)))
{
die("ERROR: no data found in $gcno_filename!\n");
}
return %result;
}
#
# read_gcno_string(handle, endianness);
#
# Read a string in 4-byte chunks from HANDLE.
#
# Return (number of 4-byte chunks read, string).
#
sub read_gcno_string(*$)
{
my $handle = $_[0];
my $endianness = $_[1];
my $number_of_blocks = 0;
my $string = "";
my $packed_word;
read($handle, $packed_word, 4) == 4
or die("ERROR: reading string\n");
$number_of_blocks = unpack_int32($packed_word, $endianness);
if ($number_of_blocks == 0)
{
return (1, undef);
}
if (read($handle, $packed_word, 4 * $number_of_blocks) !=
4 * $number_of_blocks)
{
my $msg = "invalid string size ".(4 * $number_of_blocks)." in ".
"gcno file at position ".tell($handle)."\n";
if ($ignore[$ERROR_SOURCE])
{
warn("WARNING: $msg");
return (1, undef);
}
else
{
die("ERROR: $msg");
}
}
$string = $string . $packed_word;
# Remove trailing nil bytes
$/="\0";
while (chomp($string)) {};
$/="\n";
return(1 + $number_of_blocks, $string);
}
#
# read_hammer_bbg_file(bb_filename, base_dir)
#
# Read .bbg file BB_FILENAME and return a hash containing the following
# mapping:
#
# filename -> comma-separated list of pairs (function name=starting
# line number) to indicate the starting line of a function or
# =name to indicate an instrumented line
#
# for each entry in the .bbg file. Filenames are absolute, i.e. relative
# filenames are prefixed with BASE_DIR.
#
# Die on error.
#
sub read_hammer_bbg_file($$)
{
my $bbg_filename = $_[0];
my $base_dir = $_[1];
my %result;
my $filename;
my $function_name;
my $first_line;
my $lineno;
my $length;
my $value;
my $endianness;
my $blocks;
my $packed_word;
local *INPUT;
open(INPUT, $bbg_filename)
or die("ERROR: cannot read $bbg_filename!\n");
binmode(INPUT);
# Read magic
read(INPUT, $packed_word, 4) == 4
or die("ERROR: invalid bbg file format\n");
$endianness = 1;
unpack_int32($packed_word, $endianness) == $BBG_FILE_MAGIC
or die("ERROR: bbg file magic does not match\n");
# Skip version
seek(INPUT, 4, 1);
# Read data in words of 4 bytes
while (read(INPUT, $packed_word, 4) == 4)
{
# Get record tag
$value = unpack_int32($packed_word, $endianness);
# Get record length
read(INPUT, $packed_word, 4);
$length = unpack_int32($packed_word, $endianness);
if ($value == $GCNO_FUNCTION_TAG)
{
# Get function name
($value, $function_name) =
read_hammer_bbg_string(*INPUT, $endianness);
$function_name =~ s/\W/_/g;
$filename = undef;
$first_line = undef;
seek(INPUT, $length - $value * 4, 1);
}
elsif ($value == $GCNO_LINES_TAG)
{
# Get linenumber and filename
# Skip block number
seek(INPUT, 4, 1);
$length -= 4;
while ($length > 0)
{
read(INPUT, $packed_word, 4);
$lineno = unpack_int32($packed_word,
$endianness);
$length -= 4;
if ($lineno != 0)
{
if (!defined($first_line))
{
$first_line = $lineno;
}
if (defined($filename))
{
$result{$filename} .=
($result{$filename} ? "," : "").
"=$lineno";
}
else
{
warn("WARNING: unassigned line".
" number in .bbg file ".
"$bbg_filename\n");
}
next;
}
($blocks, $value) =
read_hammer_bbg_string(
*INPUT, $endianness);
# Add all filenames to result list
if (defined($value))
{
$value = solve_relative_path(
$base_dir, $value);
if (!defined($result{$value}))
{
$result{$value} = undef;
}
if (!defined($filename))
{
$filename = $value;
}
}
$length -= $blocks * 4;
# Got a complete data set?
if (defined($filename) &&
defined($first_line) &&
defined($function_name))
{
# Add it to our result hash
if (defined($result{$filename}))
{
$result{$filename} .=
",$function_name=$first_line";
}
else
{
$result{$filename} =
"$function_name=$first_line";
}
$function_name = undef;
$filename = undef;
$first_line = undef;
}
}
}
else
{
# Skip other records
seek(INPUT, $length, 1);
}
}
close(INPUT);
if (!scalar(keys(%result)))
{
die("ERROR: no data found in $bbg_filename!\n");
}
return %result;
}
#
# read_hammer_bbg_string(handle, endianness);
#
# Read a string in 4-byte chunks from HANDLE.
#
# Return (number of 4-byte chunks read, string).
#
sub read_hammer_bbg_string(*$)
{
my $handle = $_[0];
my $endianness = $_[1];
my $length = 0;
my $string = "";
my $packed_word;
my $pad;
read($handle, $packed_word, 4) == 4
or die("ERROR: reading string\n");
$length = unpack_int32($packed_word, $endianness);
$pad = 4 - $length % 4;
if ($length == 0)
{
return (1, undef);
}
read($handle, $string, $length) ==
$length or die("ERROR: reading string\n");
seek($handle, $pad, 1);
return(1 + ($length + $pad) / 4, $string);
}
#
# unpack_int32(word, endianness)
#
# Interpret 4-byte binary string WORD as signed 32 bit integer in
# endian encoding defined by ENDIANNESS (0=little, 1=big) and return its
# value.
#
sub unpack_int32($$)
{
return sprintf("%d", unpack($_[1] ? "N" : "V",$_[0]));
}
#
# Get the GCOV tool version. Return an integer number which represents the
# GCOV version. Version numbers can be compared using standard integer
# operations.
#
sub get_gcov_version()
{
local *HANDLE;
my $version_string;
my $result;
open(GCOV_PIPE, "$gcov_tool -v |")
or die("ERROR: cannot retrieve gcov version!\n");
$version_string = <GCOV_PIPE>;
close(GCOV_PIPE);
$result = 0;
if ($version_string =~ /(\d+)\.(\d+)(\.(\d+))?/)
{
if (defined($4))
{
info("Found gcov version: $1.$2.$4\n");
$result = $1 << 16 | $2 << 8 | $4;
}
else
{
info("Found gcov version: $1.$2\n");
$result = $1 << 16 | $2 << 8;
}
}
if ($version_string =~ /suse/i && $result == 0x30303 ||
$version_string =~ /mandrake/i && $result == 0x30302)
{
info("Using compatibility mode for GCC 3.3 (hammer)\n");
$compatibility = $COMPAT_HAMMER;
}
return $result;
}
#
# info(printf_parameter)
#
# Use printf to write PRINTF_PARAMETER to stdout only when the $quiet flag
# is not set.
#
sub info(@)
{
if (!$quiet)
{
# Print info string
if (defined($output_filename) && ($output_filename eq "-"))
{
# Don't interfere with the .info output to STDOUT
printf(STDERR @_);
}
else
{
printf(@_);
}
}
}
#
# int_handler()
#
# Called when the script was interrupted by an INT signal (e.g. CTRl-C)
#
sub int_handler()
{
if ($cwd) { chdir($cwd); }
info("Aborted.\n");
exit(1);
}
#
# system_no_output(mode, parameters)
#
# Call an external program using PARAMETERS while suppressing depending on
# the value of MODE:
#
# MODE & 1: suppress STDOUT
# MODE & 2: suppress STDERR
#
# Return 0 on success, non-zero otherwise.
#
sub system_no_output($@)
{
my $mode = shift;
my $result;
local *OLD_STDERR;
local *OLD_STDOUT;
# Save old stdout and stderr handles
($mode & 1) && open(OLD_STDOUT, ">>&STDOUT");
($mode & 2) && open(OLD_STDERR, ">>&STDERR");
# Redirect to /dev/null
($mode & 1) && open(STDOUT, ">/dev/null");
($mode & 2) && open(STDERR, ">/dev/null");
system(@_);
$result = $?;
# Close redirected handles
($mode & 1) && close(STDOUT);
($mode & 2) && close(STDERR);
# Restore old handles
($mode & 1) && open(STDOUT, ">>&OLD_STDOUT");
($mode & 2) && open(STDERR, ">>&OLD_STDERR");
return $result;
}
#
# read_config(filename)
#
# Read configuration file FILENAME and return a reference to a hash containing
# all valid key=value pairs found.
#
sub read_config($)
{
my $filename = $_[0];
my %result;
my $key;
my $value;
local *HANDLE;
if (!open(HANDLE, "<$filename"))
{
warn("WARNING: cannot read configuration file $filename\n");
return undef;
}
while (<HANDLE>)
{
chomp;
# Skip comments
s/#.*//;
# Remove leading blanks
s/^\s+//;
# Remove trailing blanks
s/\s+$//;
next unless length;
($key, $value) = split(/\s*=\s*/, $_, 2);
if (defined($key) && defined($value))
{
$result{$key} = $value;
}
else
{
warn("WARNING: malformed statement in line $. ".
"of configuration file $filename\n");
}
}
close(HANDLE);
return \%result;
}
#
# apply_config(REF)
#
# REF is a reference to a hash containing the following mapping:
#
# key_string => var_ref
#
# where KEY_STRING is a keyword and VAR_REF is a reference to an associated
# variable. If the global configuration hash CONFIG contains a value for
# keyword KEY_STRING, VAR_REF will be assigned the value for that keyword.
#
sub apply_config($)
{
my $ref = $_[0];
foreach (keys(%{$ref}))
{
if (defined($config->{$_}))
{
${$ref->{$_}} = $config->{$_};
}
}
}
sub gen_initial_info($)
{
my $directory = $_[0];
my @file_list;
if (-d $directory)
{
info("Scanning $directory for $graph_file_extension ".
"files ...\n");
@file_list = `find "$directory" $maxdepth $follow -name \\*$graph_file_extension -type f 2>/dev/null`;
chomp(@file_list);
@file_list or die("ERROR: no $graph_file_extension files ".
"found in $directory!\n");
info("Found %d graph files in %s\n", $#file_list+1, $directory);
}
else
{
@file_list = ($directory);
}
# Process all files in list
foreach (@file_list) { process_graphfile($_); }
}
sub process_graphfile($)
{
my $graph_filename = $_[0];
my $graph_dir;
my $graph_basename;
my $source_dir;
my $base_dir;
my %graph_data;
my $filename;
local *INFO_HANDLE;
info("Processing $_[0]\n");
# Get path to data file in absolute and normalized form (begins with /,
# contains no more ../ or ./)
$graph_filename = solve_relative_path($cwd, $graph_filename);
# Get directory and basename of data file
($graph_dir, $graph_basename) = split_filename($graph_filename);
# avoid files from .libs dirs
if ($compat_libtool && $graph_dir =~ m/(.*)\/\.libs$/) {
$source_dir = $1;
} else {
$source_dir = $graph_dir;
}
# Construct base_dir for current file
if ($base_directory)
{
$base_dir = $base_directory;
}
else
{
$base_dir = $source_dir;
}
if ($gcov_version < $GCOV_VERSION_3_4_0)
{
if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER)
{
%graph_data = read_hammer_bbg_file($graph_filename,
$base_dir);
}
else
{
%graph_data = read_bb_file($graph_filename, $base_dir);
}
}
else
{
%graph_data = read_gcno_file($graph_filename, $base_dir);
}
# Check whether we're writing to a single file
if ($output_filename)
{
if ($output_filename eq "-")
{
*INFO_HANDLE = *STDOUT;
}
else
{
# Append to output file
open(INFO_HANDLE, ">>$output_filename")
or die("ERROR: cannot write to ".
"$output_filename!\n");
}
}
else
{
# Open .info file for output
open(INFO_HANDLE, ">$graph_filename.info")
or die("ERROR: cannot create $graph_filename.info!\n");
}
# Write test name
printf(INFO_HANDLE "TN:%s\n", $test_name);
foreach $filename (keys(%graph_data))
{
my %lines;
my $count = 0;
my @functions;
print(INFO_HANDLE "SF:$filename\n");
# Write function related data
foreach (split(",",$graph_data{$filename}))
{
my ($fn, $line) = split("=", $_);
if ($fn eq "")
{
$lines{$line} = "";
next;
}
# Normalize function name
$fn =~ s/\W/_/g;
print(INFO_HANDLE "FN:$line,$fn\n");
push(@functions, $fn);
}
foreach (@functions) {
print(INFO_HANDLE "FNDA:$_,0\n");
}
print(INFO_HANDLE "FNF:".scalar(@functions)."\n");
print(INFO_HANDLE "FNH:0\n");
# Write line related data
foreach (sort {$a <=> $b } keys(%lines))
{
print(INFO_HANDLE "DA:$_,0\n");
$count++;
}
print(INFO_HANDLE "LH:0\n");
print(INFO_HANDLE "LF:$count\n");
print(INFO_HANDLE "end_of_record\n");
}
if (!($output_filename && ($output_filename eq "-")))
{
close(INFO_HANDLE);
}
}
sub warn_handler($)
{
my ($msg) = @_;
warn("$tool_name: $msg");
}
sub die_handler($)
{
my ($msg) = @_;
die("$tool_name: $msg");
}