1742 lines
37 KiB
Perl
Executable File
1742 lines
37 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
#
|
|
# Copyright (c) International Business Machines Corp., 2002
|
|
#
|
|
# 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
|
|
#
|
|
|
|
use strict;
|
|
use File::Basename;
|
|
use Getopt::Long;
|
|
use Digest::MD5 qw(md5_base64);
|
|
|
|
|
|
# Constants
|
|
our $lcov_version = "LTP GCOV extension version 1.4";
|
|
our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php";
|
|
our $gcov_tool = "gcov";
|
|
|
|
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_SLES9 = "sles9";
|
|
|
|
# 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_sles9_bbg_file($);
|
|
sub read_sles9_bbg_string(*$);
|
|
sub unpack_int32($$);
|
|
sub info(@);
|
|
sub get_gcov_version();
|
|
sub system_no_output($@);
|
|
sub read_config($);
|
|
sub apply_config($);
|
|
|
|
# Global variables
|
|
our $gcov_version;
|
|
our $graph_file_extension;
|
|
our $data_file_extension;
|
|
our @data_directory;
|
|
our $test_name = "";
|
|
our $source_dirs = "";
|
|
our $quiet;
|
|
our $help;
|
|
our $output_filename;
|
|
our $version;
|
|
our $follow;
|
|
our $nochecksum;
|
|
our $preserve_paths;
|
|
our $adjust_testname = (`uname -m` =~ /^s390/); # Always on on s390
|
|
our $config; # Configuration file contents
|
|
our $compatibility; # Compatibility version flag - used to indicate
|
|
# non-standard GCOV data format versions
|
|
|
|
our $cwd = `pwd`;
|
|
chomp($cwd);
|
|
|
|
|
|
#
|
|
# Code entry point
|
|
#
|
|
|
|
# Register handler routine to be called when interrupted
|
|
$SIG{"INT"} = \&int_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_no_checksum" => \$nochecksum});
|
|
}
|
|
|
|
# Parse command line options
|
|
if (!GetOptions("test-name=s" => \$test_name,
|
|
"output-filename=s" => \$output_filename,
|
|
"source-dirs=s" => \$source_dirs,
|
|
"no-checksum" => \$nochecksum,
|
|
"version" =>\$version,
|
|
"quiet" => \$quiet,
|
|
"help" => \$help,
|
|
"follow" => \$follow
|
|
))
|
|
{
|
|
print_usage(*STDERR);
|
|
exit(1);
|
|
}
|
|
|
|
@data_directory = @ARGV;
|
|
|
|
# Check for help option
|
|
if ($help)
|
|
{
|
|
print_usage(*STDOUT);
|
|
exit(0);
|
|
}
|
|
|
|
# Check for version option
|
|
if ($version)
|
|
{
|
|
print($lcov_version."\n");
|
|
exit(0);
|
|
}
|
|
|
|
# Adjust test name if necessary (standard for s390 architecture)
|
|
if ($adjust_testname)
|
|
{
|
|
$test_name .= "__".`uname -a`;
|
|
$test_name =~ s/\W/_/g;
|
|
}
|
|
|
|
# Check for follow option
|
|
if ($follow)
|
|
{
|
|
$follow = "-follow"
|
|
}
|
|
else
|
|
{
|
|
$follow = "";
|
|
}
|
|
|
|
# Check for directory name
|
|
if (!@data_directory)
|
|
{
|
|
print(STDERR "No directory specified\n");
|
|
print_usage(*STDERR);
|
|
exit(1);
|
|
}
|
|
else
|
|
{
|
|
foreach (@data_directory)
|
|
{
|
|
stat($_);
|
|
if (!-r _)
|
|
{
|
|
die("ERROR: cannot read $_!\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_SLES9)
|
|
{
|
|
$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
|
|
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];
|
|
my $tool_name = basename($0);
|
|
|
|
print(HANDLE <<END_OF_USAGE);
|
|
Usage: $tool_name [OPTIONS] DIRECTORY
|
|
|
|
Traverse DIRECTORY and create a .info file for each .da/.gcda 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
|
|
-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
|
|
-n, --no-checksum Do not calculate checksum for each line
|
|
|
|
See $lcov_url for more information about this tool.
|
|
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 $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 $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_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 $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 @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);
|
|
|
|
# Check for writable $da_dir (gcov will try to write files there)
|
|
stat($da_dir);
|
|
if (!-w _)
|
|
{
|
|
die("ERROR: cannot write to directory $da_dir!\n");
|
|
}
|
|
|
|
if (-z $da_filename)
|
|
{
|
|
$da_renamed = 1;
|
|
}
|
|
else
|
|
{
|
|
$da_renamed = 0;
|
|
}
|
|
|
|
# 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))
|
|
{
|
|
$bb_filename = readlink($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_SLES9)
|
|
{
|
|
%bb_content = read_sles9_bbg_file($bb_filename);
|
|
}
|
|
else
|
|
{
|
|
%bb_content = read_bb_file($bb_filename);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
%bb_content = read_gcno_file($bb_filename);
|
|
}
|
|
|
|
# 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. We need to apply GCOV with using that directory to
|
|
# ensure that all relative #include-files are found as well.
|
|
($object_dir) = split_filename($bb_filename);
|
|
|
|
# Is the data file in the same directory with all the other files?
|
|
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($object_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_basename.".c",
|
|
"-o", $object_dir,
|
|
"--preserve-paths",
|
|
"-b");
|
|
}
|
|
else
|
|
{
|
|
$gcov_error = system_no_output(1, $gcov_tool, $da_basename.".c",
|
|
"-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);
|
|
}
|
|
|
|
$gcov_error and 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 ($source)
|
|
{
|
|
$source = solve_relative_path($object_dir, $source);
|
|
}
|
|
|
|
# gcov will happily create output even if there's no source code
|
|
# available - this interfers with checksum creation so we need
|
|
# to pull the emergency brake here.
|
|
if (defined($source) && ! -r $source && ! $nochecksum)
|
|
{
|
|
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]};
|
|
|
|
# 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
|
|
foreach (split(",",$bb_content{$source_filename}))
|
|
{
|
|
# Write "line_number,function_name" for each function.
|
|
# Note that $_ contains this information in the form
|
|
# "function_name=line_number" so that the order of
|
|
# elements has to be reversed.
|
|
printf(INFO_HANDLE "FN:%s\n",
|
|
join(",", (split("=", $_))[1,0]));
|
|
}
|
|
|
|
# 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].($nochecksum ? "" :
|
|
",". 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);
|
|
}
|
|
|
|
|
|
# cleanup_path (path)
|
|
sub cleanup_path($@)
|
|
{
|
|
my $result = shift @_;
|
|
|
|
# Remove //
|
|
$result =~ s/\/\//\//g;
|
|
|
|
# Remove .
|
|
$result =~ s/\/\.\//\//g;
|
|
|
|
# Solve ..
|
|
while ($result =~ s/\/[^\/]+\/\.\.\//\//)
|
|
{
|
|
}
|
|
|
|
# Remove preceding ..
|
|
$result =~ s/^\/\.\.\//\//g;
|
|
|
|
return $result;
|
|
}
|
|
|
|
#
|
|
# 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";
|
|
}
|
|
|
|
$result = cleanup_path ($result);
|
|
|
|
if (-f $result) {
|
|
return $result;
|
|
}
|
|
for my $prefix (split (':', $source_dirs)) {
|
|
$result = cleanup_path ("$prefix/$dir");
|
|
if (-f $result) {
|
|
return $result;
|
|
}
|
|
}
|
|
|
|
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;
|
|
|
|
open(INPUT, $_[0])
|
|
or 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)
|
|
#
|
|
# 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
|
|
#
|
|
# Die on error.
|
|
#
|
|
|
|
sub read_gcov_file($)
|
|
{
|
|
my $filename = $_[0];
|
|
my @result = ();
|
|
my @branches = ();
|
|
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 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 (/^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);
|
|
}
|
|
|
|
|
|
#
|
|
# read_bb_file(bb_filename)
|
|
#
|
|
# Read .bb file BB_FILENAME and return a hash containing the following
|
|
# mapping:
|
|
#
|
|
# filename -> comma-separated list of pairs (function name=starting
|
|
# line number) for each function found
|
|
#
|
|
# for each entry in the .bb file. Filenames are absolute, i.e. relative
|
|
# filenames are prefixed with bb_filename's path component.
|
|
#
|
|
# Die on error.
|
|
#
|
|
|
|
sub read_bb_file($)
|
|
{
|
|
my $bb_filename = $_[0];
|
|
my %result;
|
|
my $filename;
|
|
my $function_name;
|
|
my $cwd = `pwd`;
|
|
chomp($cwd);
|
|
my $base_dir = get_dir(solve_relative_path(
|
|
$cwd, $bb_filename));
|
|
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");
|
|
}
|
|
elsif ($value > 0)
|
|
{
|
|
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)
|
|
#
|
|
# Read .gcno file BB_FILENAME and return a hash containing the following
|
|
# mapping:
|
|
#
|
|
# filename -> comma-separated list of pairs (function name=starting
|
|
# line number) for each function found
|
|
#
|
|
# for each entry in the .gcno file. Filenames are absolute, i.e. relative
|
|
# filenames are prefixed with bb_filename's path component.
|
|
#
|
|
# Die on error.
|
|
#
|
|
|
|
sub read_gcno_file($)
|
|
{
|
|
my $gcno_filename = $_[0];
|
|
my %result;
|
|
my $filename;
|
|
my $function_name;
|
|
my $lineno;
|
|
my $length;
|
|
my $cwd = `pwd`;
|
|
my $value;
|
|
my $endianness;
|
|
my $blocks;
|
|
chomp($cwd);
|
|
my $base_dir = get_dir(solve_relative_path(
|
|
$cwd, $gcno_filename));
|
|
my $packed_word;
|
|
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);
|
|
(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);
|
|
while ($length > 0)
|
|
{
|
|
read(INPUT, $packed_word, 4);
|
|
$lineno = unpack_int32($packed_word,
|
|
$endianness);
|
|
$length--;
|
|
if ($lineno != 0)
|
|
{
|
|
next;
|
|
}
|
|
($blocks, $filename) =
|
|
read_gcno_string(*INPUT, $endianness);
|
|
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);
|
|
}
|
|
|
|
read($handle, $packed_word, 4 * $number_of_blocks) ==
|
|
4 * $number_of_blocks or die("ERROR: reading string\n");
|
|
|
|
$string = $string . $packed_word;
|
|
|
|
# Remove trailing nil bytes
|
|
$/="\0";
|
|
while (chomp($string)) {};
|
|
$/="\n";
|
|
|
|
return(1 + $number_of_blocks, $string);
|
|
}
|
|
|
|
|
|
#
|
|
# read_sles9_bbg_file(bb_filename)
|
|
#
|
|
# Read .bbg file BB_FILENAME and return a hash containing the following
|
|
# mapping:
|
|
#
|
|
# filename -> comma-separated list of pairs (function name=starting
|
|
# line number) for each function found
|
|
#
|
|
# for each entry in the .bbg file. Filenames are absolute, i.e. relative
|
|
# filenames are prefixed with bb_filename's path component.
|
|
#
|
|
# Die on error.
|
|
#
|
|
|
|
sub read_sles9_bbg_file($)
|
|
{
|
|
my $bbg_filename = $_[0];
|
|
my %result;
|
|
my $filename;
|
|
my $function_name;
|
|
my $first_line;
|
|
my $lineno;
|
|
my $length;
|
|
my $cwd = `pwd`;
|
|
my $value;
|
|
my $endianness;
|
|
my $blocks;
|
|
chomp($cwd);
|
|
my $base_dir = get_dir(solve_relative_path($cwd, $bbg_filename));
|
|
my $packed_word;
|
|
local *INPUT;
|
|
|
|
open(INPUT, $bbg_filename)
|
|
or die("ERROR: cannot read $bbg_filename!\n");
|
|
|
|
binmode(INPUT);
|
|
|
|
read(INPUT, $packed_word, 4) == 4
|
|
or die("ERROR: invalid bbg file format\n");
|
|
|
|
$value = unpack_int32($packed_word, 0);
|
|
$endianness = 1;
|
|
|
|
unpack_int32($packed_word, $endianness) == $BBG_FILE_MAGIC
|
|
or die("ERROR: bbg file magic does not match\n");
|
|
|
|
seek(INPUT, 4, 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);
|
|
|
|
# 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_sles9_bbg_string(*INPUT, $endianness);
|
|
|
|
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;
|
|
}
|
|
next;
|
|
}
|
|
($blocks, $value) =
|
|
read_sles9_bbg_string(
|
|
*INPUT, $endianness);
|
|
if (!defined($filename))
|
|
{
|
|
$filename = $value;
|
|
}
|
|
$length -= $blocks * 4;
|
|
}
|
|
# Got a complete data set?
|
|
if (defined($filename) && defined($function_name) &&
|
|
defined($first_line))
|
|
{
|
|
$filename = solve_relative_path(
|
|
$base_dir, $filename);
|
|
# Add it to our result hash
|
|
if (defined($result{$filename}))
|
|
{
|
|
$result{$filename} .=
|
|
",$function_name=$first_line";
|
|
}
|
|
else
|
|
{
|
|
$result{$filename} =
|
|
"$function_name=$first_line";
|
|
}
|
|
$filename = undef;
|
|
$function_name = 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_sles9_bbg_string(handle, endianness);
|
|
#
|
|
# Read a string in 4-byte chunks from HANDLE.
|
|
#
|
|
# Return (number of 4-byte chunks read, string).
|
|
#
|
|
|
|
sub read_sles9_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, endianess)
|
|
#
|
|
# 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)
|
|
{
|
|
info("Using compatibility mode for SUSE GCC 3.3.3\n");
|
|
$compatibility = $COMPAT_SLES9;
|
|
}
|
|
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 interfer 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->{$_};
|
|
}
|
|
}
|
|
}
|