blob: 6304d7510970f50399aa4b71379a9c44ef9314e2 [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
#
#
# lcov
#
# This is a wrapper script which provides a single interface for accessing
# LCOV coverage data.
#
#
# History:
# 2002-08-29 created by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com>
# IBM Lab Boeblingen
# 2002-09-05 / Peter Oberparleiter: implemented --kernel-directory +
# multiple directories
# 2002-10-16 / Peter Oberparleiter: implemented --add-tracefile option
# 2002-10-17 / Peter Oberparleiter: implemented --extract option
# 2002-11-04 / Peter Oberparleiter: implemented --list option
# 2003-03-07 / Paul Larson: Changed to make it work with the latest gcov
# kernel patch. This will break it with older gcov-kernel
# patches unless you change the value of $gcovmod in this script
# 2003-04-07 / Peter Oberparleiter: fixed bug which resulted in an error
# when trying to combine .info files containing data without
# a test name
# 2003-04-10 / Peter Oberparleiter: extended Paul's change so that LCOV
# works both with the new and the old gcov-kernel patch
# 2003-04-10 / Peter Oberparleiter: added $gcov_dir constant in anticipation
# of a possible move of the gcov kernel directory to another
# file system in a future version of the gcov-kernel patch
# 2003-04-15 / Paul Larson: make info write to STDERR, not STDOUT
# 2003-04-15 / Paul Larson: added --remove option
# 2003-04-30 / Peter Oberparleiter: renamed --reset to --zerocounters
# to remove naming ambiguity with --remove
# 2003-04-30 / Peter Oberparleiter: adjusted help text to include --remove
# 2003-06-27 / Peter Oberparleiter: implemented --diff
# 2003-07-03 / Peter Oberparleiter: added line checksum support, added
# --no-checksum
# 2003-12-11 / Laurent Deniel: added --follow option
# 2004-03-29 / Peter Oberparleiter: modified --diff option to better cope with
# ambiguous patch file entries, modified --capture option to use
# modprobe before insmod (needed for 2.6)
# 2004-03-30 / Peter Oberparleiter: added --path option
# 2004-08-09 / Peter Oberparleiter: added configuration file support
# 2008-08-13 / Peter Oberparleiter: added function coverage support
#
use strict;
use File::Basename;
use Getopt::Long;
# Global constants
our $lcov_version = "LCOV version 1.7";
our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php";
our $tool_name = basename($0);
# Names of the GCOV kernel module
our @gcovmod = ("gcov-prof", "gcov-proc");
# Directory containing gcov kernel files
our $gcov_dir = "/proc/gcov";
# The location of the insmod tool
our $insmod_tool = "/sbin/insmod";
# The location of the modprobe tool
our $modprobe_tool = "/sbin/modprobe";
# The location of the rmmod tool
our $rmmod_tool = "/sbin/rmmod";
# Where to create temporary directories
our $tmp_dir = "/tmp";
# How to prefix a temporary directory name
our $tmp_prefix = "tmpdir";
# Prototypes
sub print_usage(*);
sub check_options();
sub userspace_reset();
sub userspace_capture();
sub kernel_reset();
sub kernel_capture();
sub add_traces();
sub read_info_file($);
sub get_info_entry($);
sub set_info_entry($$$$$$$;$$$$);
sub add_counts($$);
sub merge_checksums($$$);
sub combine_info_entries($$$);
sub combine_info_files($$);
sub write_info_file(*$);
sub extract();
sub remove();
sub list();
sub get_common_filename($$);
sub read_diff($);
sub diff();
sub system_no_output($@);
sub read_config($);
sub apply_config($);
sub info(@);
sub unload_module($);
sub check_and_load_kernel_module();
sub create_temp_dir();
sub transform_pattern($);
sub warn_handler($);
sub die_handler($);
# Global variables & initialization
our @directory; # Specifies where to get coverage data from
our @kernel_directory; # If set, captures only from specified kernel subdirs
our @add_tracefile; # If set, reads in and combines all files in list
our $list; # If set, list contents of tracefile
our $extract; # If set, extracts parts of tracefile
our $remove; # If set, removes parts of tracefile
our $diff; # If set, modifies tracefile according to diff
our $reset; # If set, reset all coverage data to zero
our $capture; # If set, capture data
our $output_filename; # Name for file to write coverage data to
our $test_name = ""; # Test case name
our $quiet = ""; # If set, suppress information messages
our $help; # Help option flag
our $version; # Version option flag
our $convert_filenames; # If set, convert filenames when applying diff
our $strip; # If set, strip leading directories when applying diff
our $need_unload; # If set, unload gcov kernel module
our $temp_dir_name; # Name of temporary directory
our $cwd = `pwd`; # Current working directory
our $to_file; # If set, indicates that output is written to a file
our $follow; # If set, indicates that find shall follow links
our $diff_path = ""; # Path removed from tracefile when applying diff
our $base_directory; # Base directory (cwd of gcc during compilation)
our $checksum; # If set, calculate a checksum for each line
our $no_checksum; # If set, don't calculate a checksum for each line
our $compat_libtool; # If set, indicates that libtool mode is to be enabled
our $no_compat_libtool; # If set, indicates that libtool mode is to be disabled
our $gcov_tool;
our $ignore_errors;
our $initial;
our $no_recursion = 0;
our $maxdepth;
our $config; # Configuration file contents
chomp($cwd);
our $tool_dir = dirname($0); # Directory where genhtml tool is installed
#
# Code entry point
#
$SIG{__WARN__} = \&warn_handler;
$SIG{__DIE__} = \&die_handler;
# Add current working directory if $tool_dir is not already an absolute path
if (! ($tool_dir =~ /^\/(.*)$/))
{
$tool_dir = "$cwd/$tool_dir";
}
# 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({
"lcov_gcov_dir" => \$gcov_dir,
"lcov_insmod_tool" => \$insmod_tool,
"lcov_modprobe_tool" => \$modprobe_tool,
"lcov_rmmod_tool" => \$rmmod_tool,
"lcov_tmp_dir" => \$tmp_dir});
}
# Parse command line options
if (!GetOptions("directory|d|di=s" => \@directory,
"add-tracefile=s" => \@add_tracefile,
"list=s" => \$list,
"kernel-directory=s" => \@kernel_directory,
"extract=s" => \$extract,
"remove=s" => \$remove,
"diff=s" => \$diff,
"convert-filenames" => \$convert_filenames,
"strip=i" => \$strip,
"capture|c" => \$capture,
"output-file=s" => \$output_filename,
"test-name=s" => \$test_name,
"zerocounters" => \$reset,
"quiet" => \$quiet,
"help|?" => \$help,
"version" => \$version,
"follow" => \$follow,
"path=s" => \$diff_path,
"base-directory=s" => \$base_directory,
"checksum" => \$checksum,
"no-checksum" => \$no_checksum,
"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;
}
}
# 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);
}
# Normalize --path text
$diff_path =~ s/\/$//;
if ($follow)
{
$follow = "-follow";
}
else
{
$follow = "";
}
if ($no_recursion)
{
$maxdepth = "-maxdepth 1";
}
else
{
$maxdepth = "";
}
# Check for valid options
check_options();
# Only --extract, --remove and --diff allow unnamed parameters
if (@ARGV && !($extract || $remove || $diff))
{
die("Extra parameter found\n".
"Use $tool_name --help to get usage information\n");
}
# Check for output filename
$to_file = ($output_filename && ($output_filename ne "-"));
if ($capture)
{
if (!$to_file)
{
# Option that tells geninfo to write to stdout
$output_filename = "-";
}
}
else
{
if ($initial)
{
die("Option --initial is only valid when capturing data (-c)\n".
"Use $tool_name --help to get usage information\n");
}
}
# Check for requested functionality
if ($reset)
{
# Differentiate between user space and kernel reset
if (@directory)
{
userspace_reset();
}
else
{
kernel_reset();
}
}
elsif ($capture)
{
# Differentiate between user space and kernel
if (@directory)
{
userspace_capture();
}
else
{
kernel_capture();
}
}
elsif (@add_tracefile)
{
add_traces();
}
elsif ($remove)
{
remove();
}
elsif ($extract)
{
extract();
}
elsif ($list)
{
list();
}
elsif ($diff)
{
if (scalar(@ARGV) != 1)
{
die("ERROR: option --diff requires one additional argument!\n".
"Use $tool_name --help to get usage information\n");
}
diff();
}
info("Done.\n");
exit(0);
#
# print_usage(handle)
#
# Print usage information.
#
sub print_usage(*)
{
local *HANDLE = $_[0];
print(HANDLE <<END_OF_USAGE);
Usage: $tool_name [OPTIONS]
Use lcov to collect coverage data from either the currently running Linux
kernel or from a user space application. Specify the --directory option to
get coverage data for a user space program.
Misc:
-h, --help Print this help, then exit
-v, --version Print version number, then exit
-q, --quiet Do not print progress messages
Operation:
-z, --zerocounters Reset all execution counts to zero
-c, --capture Capture coverage data
-a, --add-tracefile FILE Add contents of tracefiles
-e, --extract FILE PATTERN Extract files matching PATTERN from FILE
-r, --remove FILE PATTERN Remove files matching PATTERN from FILE
-l, --list FILE List contents of tracefile FILE
--diff FILE DIFF Transform tracefile FILE according to DIFF
Options:
-i, --initial Capture initial zero coverage data
-t, --test-name NAME Specify test name to be stored with data
-o, --output-file FILENAME Write data to FILENAME instead of stdout
-d, --directory DIR Use .da files in DIR instead of kernel
-f, --follow Follow links when searching .da files
-k, --kernel-directory KDIR Capture kernel coverage data only from KDIR
-b, --base-directory DIR Use DIR as base directory for relative paths
--convert-filenames Convert filenames when applying diff
--strip DEPTH Strip initial DEPTH directory levels in diff
--path PATH Strip PATH from tracefile when applying diff
--(no-)checksum Enable (disable) line checksumming
--(no-)compat-libtool Enable (disable) libtool compatibility mode
--gcov-tool TOOL Specify gcov tool location
--ignore-errors ERRORS Continue after ERRORS (gcov, source)
--no-recursion Exlude subdirectories from processing
For more information see: $lcov_url
END_OF_USAGE
;
}
#
# check_options()
#
# Check for valid combination of command line options. Die on error.
#
sub check_options()
{
my $i = 0;
# Count occurrence of mutually exclusive options
$reset && $i++;
$capture && $i++;
@add_tracefile && $i++;
$extract && $i++;
$remove && $i++;
$list && $i++;
$diff && $i++;
if ($i == 0)
{
die("Need one of the options -z, -c, -a, -e, -r, -l or ".
"--diff\n".
"Use $tool_name --help to get usage information\n");
}
elsif ($i > 1)
{
die("ERROR: only one of -z, -c, -a, -e, -r, -l or ".
"--diff allowed!\n".
"Use $tool_name --help to get usage information\n");
}
}
#
# userspace_reset()
#
# Reset coverage data found in DIRECTORY by deleting all contained .da files.
#
# Die on error.
#
sub userspace_reset()
{
my $current_dir;
my @file_list;
foreach $current_dir (@directory)
{
info("Deleting all .da files in $current_dir".
($no_recursion?"\n":" and subdirectories\n"));
@file_list = `find "$current_dir" $maxdepth $follow -name \\*\\.da -o -name \\*\\.gcda -type f 2>/dev/null`;
chomp(@file_list);
foreach (@file_list)
{
unlink($_) or die("ERROR: cannot remove file $_!\n");
}
}
}
#
# userspace_capture()
#
# Capture coverage data found in DIRECTORY and write it to OUTPUT_FILENAME
# if specified, otherwise to STDOUT.
#
# Die on error.
#
sub userspace_capture()
{
my @param;
my $file_list = join(" ", @directory);
info("Capturing coverage data from $file_list\n");
@param = ("$tool_dir/geninfo", @directory);
if ($output_filename)
{
@param = (@param, "--output-filename", $output_filename);
}
if ($test_name)
{
@param = (@param, "--test-name", $test_name);
}
if ($follow)
{
@param = (@param, "--follow");
}
if ($quiet)
{
@param = (@param, "--quiet");
}
if (defined($checksum))
{
if ($checksum)
{
@param = (@param, "--checksum");
}
else
{
@param = (@param, "--no-checksum");
}
}
if ($base_directory)
{
@param = (@param, "--base-directory", $base_directory);
}
if ($no_compat_libtool)
{
@param = (@param, "--no-compat-libtool");
}
elsif ($compat_libtool)
{
@param = (@param, "--compat-libtool");
}
if ($gcov_tool)
{
@param = (@param, "--gcov-tool", $gcov_tool);
}
if ($ignore_errors)
{
@param = (@param, "--ignore-errors", $ignore_errors);
}
if ($initial)
{
@param = (@param, "--initial");
}
if ($no_recursion)
{
@param = (@param, "--no-recursion");
}
system(@param);
exit($? >> 8);
}
#
# kernel_reset()
#
# Reset kernel coverage.
#
# Die on error.
#
sub kernel_reset()
{
local *HANDLE;
check_and_load_kernel_module();
info("Resetting kernel execution counters\n");
open(HANDLE, ">$gcov_dir/vmlinux") or
die("ERROR: cannot write to $gcov_dir/vmlinux!\n");
print(HANDLE "0");
close(HANDLE);
# Unload module if we loaded it in the first place
if ($need_unload)
{
unload_module($need_unload);
}
}
#
# kernel_capture()
#
# Capture kernel coverage data and write it to OUTPUT_FILENAME if specified,
# otherwise stdout.
#
sub kernel_capture()
{
my @param;
check_and_load_kernel_module();
# Make sure the temporary directory is removed upon script termination
END
{
if ($temp_dir_name)
{
stat($temp_dir_name);
if (-r _)
{
info("Removing temporary directory ".
"$temp_dir_name\n");
# Remove temporary directory
system("rm", "-rf", $temp_dir_name)
and warn("WARNING: cannot remove ".
"temporary directory ".
"$temp_dir_name!\n");
}
}
}
# Get temporary directory
$temp_dir_name = create_temp_dir();
info("Copying kernel data to temporary directory $temp_dir_name\n");
if (!@kernel_directory)
{
# Copy files from gcov kernel directory
system("cp", "-dr", $gcov_dir, $temp_dir_name)
and die("ERROR: cannot copy files from $gcov_dir!\n");
}
else
{
# Prefix list of kernel sub-directories with the gcov kernel
# directory
@kernel_directory = map("$gcov_dir/$_", @kernel_directory);
# Copy files from gcov kernel directory
system("cp", "-dr", @kernel_directory, $temp_dir_name)
and die("ERROR: cannot copy files from ".
join(" ", @kernel_directory)."!\n");
}
# Make directories writable
system("find", $temp_dir_name, "-type", "d", "-exec", "chmod", "u+w",
"{}", ";")
and die("ERROR: cannot modify access rights for ".
"$temp_dir_name!\n");
# Make files writable
system("find", $temp_dir_name, "-type", "f", "-exec", "chmod", "u+w",
"{}", ";")
and die("ERROR: cannot modify access rights for ".
"$temp_dir_name!\n");
# Capture data
info("Capturing coverage data from $temp_dir_name\n");
@param = ("$tool_dir/geninfo", $temp_dir_name);
if ($output_filename)
{
@param = (@param, "--output-filename", $output_filename);
}
if ($test_name)
{
@param = (@param, "--test-name", $test_name);
}
if ($follow)
{
@param = (@param, "--follow");
}
if ($quiet)
{
@param = (@param, "--quiet");
}
if (defined($checksum))
{
if ($checksum)
{
@param = (@param, "--checksum");
}
else
{
@param = (@param, "--no-checksum");
}
}
if ($base_directory)
{
@param = (@param, "--base-directory", $base_directory);
}
if ($no_compat_libtool)
{
@param = (@param, "--no-compat-libtool");
}
elsif ($compat_libtool)
{
@param = (@param, "--compat-libtool");
}
if ($gcov_tool)
{
@param = (@param, "--gcov-tool", $gcov_tool);
}
if ($ignore_errors)
{
@param = (@param, "--ignore-errors", $ignore_errors);
}
if ($initial)
{
@param = (@param, "--initial");
}
system(@param) and exit($? >> 8);
# Unload module if we loaded it in the first place
if ($need_unload)
{
unload_module($need_unload);
}
}
#
# 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 ($to_file)
{
print(@_)
}
else
{
# Don't interfer with the .info output to STDOUT
printf(STDERR @_);
}
}
}
#
# Check if the gcov kernel module is loaded. If it is, exit, if not, try
# to load it.
#
# Die on error.
#
sub check_and_load_kernel_module()
{
my $module_name;
# Is it loaded already?
stat("$gcov_dir");
if (-r _) { return(); }
info("Loading required gcov kernel module.\n");
# Do we have access to the insmod tool?
stat($insmod_tool);
if (!-x _)
{
die("ERROR: need insmod tool ($insmod_tool) to access kernel ".
"coverage data!\n");
}
# Do we have access to the modprobe tool?
stat($modprobe_tool);
if (!-x _)
{
die("ERROR: need modprobe tool ($modprobe_tool) to access ".
"kernel coverage data!\n");
}
# Try some possibilities of where the gcov kernel module may be found
foreach $module_name (@gcovmod)
{
# Try to load module from system wide module directory
# /lib/modules
if (system_no_output(3, $modprobe_tool, $module_name) == 0)
{
# Succeeded
$need_unload = $module_name;
return();
}
# Try to load linux 2.5/2.6 module from tool directory
if (system_no_output(3, $insmod_tool,
"$tool_dir/$module_name.ko") == 0)
{
# Succeeded
$need_unload = $module_name;
return();
}
# Try to load linux 2.4 module from tool directory
if (system_no_output(3, $insmod_tool,
"$tool_dir/$module_name.o") == 0)
{
# Succeeded
$need_unload = $module_name;
return();
}
}
# Hm, loading failed - maybe we aren't root?
if ($> != 0)
{
die("ERROR: need root access to load kernel module!\n");
}
die("ERROR: cannot load required gcov kernel module!\n");
}
#
# unload_module()
#
# Unload the gcov kernel module.
#
sub unload_module($)
{
my $module = $_[0];
info("Unloading kernel module $module\n");
# Do we have access to the rmmod tool?
stat($rmmod_tool);
if (!-x _)
{
warn("WARNING: cannot execute rmmod tool at $rmmod_tool - ".
"gcov module still loaded!\n");
}
# Unload gcov kernel module
system_no_output(1, $rmmod_tool, $module)
and warn("WARNING: cannot unload gcov kernel module ".
"$module!\n");
}
#
# create_temp_dir()
#
# Create a temporary directory and return its path.
#
# Die on error.
#
sub create_temp_dir()
{
my $dirname;
my $number = sprintf("%d", rand(1000));
# Endless loops are evil
while ($number++ < 1000)
{
$dirname = "$tmp_dir/$tmp_prefix$number";
stat($dirname);
if (-e _) { next; }
mkdir($dirname)
or die("ERROR: cannot create temporary directory ".
"$dirname!\n");
return($dirname);
}
die("ERROR: cannot create temporary directory in $tmp_dir!\n");
}
#
# read_info_file(info_filename)
#
# Read in the contents of the .info file specified by INFO_FILENAME. Data will
# be returned as a reference to a hash containing the following mappings:
#
# %result: for each filename found in file -> \%data
#
# %data: "test" -> \%testdata
# "sum" -> \%sumcount
# "func" -> \%funcdata
# "found" -> $lines_found (number of instrumented lines found in file)
# "hit" -> $lines_hit (number of executed lines in file)
# "check" -> \%checkdata
# "testfnc" -> \%testfncdata
# "sumfnc" -> \%sumfnccount
#
# %testdata : name of test affecting this file -> \%testcount
# %testfncdata: name of test affecting this file -> \%testfnccount
#
# %testcount : line number -> execution count for a single test
# %testfnccount: function name -> execution count for a single test
# %sumcount : line number -> execution count for all tests
# %sumfnccount : function name -> execution count for all tests
# %funcdata : function name -> line number
# %checkdata : line number -> checksum of source code line
#
# Note that .info file sections referring to the same file and test name
# will automatically be combined by adding all execution counts.
#
# Note that if INFO_FILENAME ends with ".gz", it is assumed that the file
# is compressed using GZIP. If available, GUNZIP will be used to decompress
# this file.
#
# Die on error.
#
sub read_info_file($)
{
my $tracefile = $_[0]; # Name of tracefile
my %result; # Resulting hash: file -> data
my $data; # Data handle for current entry
my $testdata; # " "
my $testcount; # " "
my $sumcount; # " "
my $funcdata; # " "
my $checkdata; # " "
my $testfncdata;
my $testfnccount;
my $sumfnccount;
my $line; # Current line read from .info file
my $testname; # Current test name
my $filename; # Current filename
my $hitcount; # Count for lines hit
my $count; # Execution count of current line
my $negative; # If set, warn about negative counts
my $changed_testname; # If set, warn about changed testname
my $line_checksum; # Checksum of current line
local *INFO_HANDLE; # Filehandle for .info file
info("Reading tracefile $tracefile\n");
# Check if file exists and is readable
stat($_[0]);
if (!(-r _))
{
die("ERROR: cannot read file $_[0]!\n");
}
# Check if this is really a plain file
if (!(-f _))
{
die("ERROR: not a plain file: $_[0]!\n");
}
# Check for .gz extension
if ($_[0] =~ /\.gz$/)
{
# Check for availability of GZIP tool
system_no_output(1, "gunzip" ,"-h")
and die("ERROR: gunzip command not available!\n");
# Check integrity of compressed file
system_no_output(1, "gunzip", "-t", $_[0])
and die("ERROR: integrity check failed for ".
"compressed file $_[0]!\n");
# Open compressed file
open(INFO_HANDLE, "gunzip -c $_[0]|")
or die("ERROR: cannot start gunzip to decompress ".
"file $_[0]!\n");
}
else
{
# Open decompressed file
open(INFO_HANDLE, $_[0])
or die("ERROR: cannot read file $_[0]!\n");
}
$testname = "";
while (<INFO_HANDLE>)
{
chomp($_);
$line = $_;
# Switch statement
foreach ($line)
{
/^TN:([^,]*)/ && do
{
# Test name information found
$testname = defined($1) ? $1 : "";
if ($testname =~ s/\W/_/g)
{
$changed_testname = 1;
}
last;
};
/^[SK]F:(.*)/ && do
{
# Filename information found
# Retrieve data for new entry
$filename = $1;
$data = $result{$filename};
($testdata, $sumcount, $funcdata, $checkdata,
$testfncdata, $sumfnccount) =
get_info_entry($data);
if (defined($testname))
{
$testcount = $testdata->{$testname};
$testfnccount = $testfncdata->{$testname};
}
else
{
$testcount = {};
$testfnccount = {};
}
last;
};
/^DA:(\d+),(-?\d+)(,[^,\s]+)?/ && do
{
# Fix negative counts
$count = $2 < 0 ? 0 : $2;
if ($2 < 0)
{
$negative = 1;
}
# Execution count found, add to structure
# Add summary counts
$sumcount->{$1} += $count;
# Add test-specific counts
if (defined($testname))
{
$testcount->{$1} += $count;
}
# Store line checksum if available
if (defined($3))
{
$line_checksum = substr($3, 1);
# Does it match a previous definition
if (defined($checkdata->{$1}) &&
($checkdata->{$1} ne
$line_checksum))
{
die("ERROR: checksum mismatch ".
"at $filename:$1\n");
}
$checkdata->{$1} = $line_checksum;
}
last;
};
/^FN:(\d+),([^,]+)/ && do
{
# Function data found, add to structure
$funcdata->{$2} = $1;
# Also initialize function call data
if (!defined($sumfnccount->{$2})) {
$sumfnccount->{$2} = 0;
}
if (defined($testname))
{
if (!defined($testfnccount->{$2})) {
$testfnccount->{$2} = 0;
}
}
last;
};
/^FNDA:(\d+),([^,]+)/ && do
{
# Function call count found, add to structure
# Add summary counts
$sumfnccount->{$2} += $1;
# Add test-specific counts
if (defined($testname))
{
$testfnccount->{$2} += $1;
}
last;
};
/^end_of_record/ && do
{
# Found end of section marker
if ($filename)
{
# Store current section data
if (defined($testname))
{
$testdata->{$testname} =
$testcount;
$testfncdata->{$testname} =
$testfnccount;
}
set_info_entry($data, $testdata,
$sumcount, $funcdata,
$checkdata, $testfncdata,
$sumfnccount);
$result{$filename} = $data;
last;
}
};
# default
last;
}
}
close(INFO_HANDLE);
# Calculate hit and found values for lines and functions of each file
foreach $filename (keys(%result))
{
$data = $result{$filename};
($testdata, $sumcount, undef, undef, $testfncdata,
$sumfnccount) = get_info_entry($data);
# Filter out empty files
if (scalar(keys(%{$sumcount})) == 0)
{
delete($result{$filename});
next;
}
# Filter out empty test cases
foreach $testname (keys(%{$testdata}))
{
if (!defined($testdata->{$testname}) ||
scalar(keys(%{$testdata->{$testname}})) == 0)
{
delete($testdata->{$testname});
delete($testfncdata->{$testname});
}
}
$data->{"found"} = scalar(keys(%{$sumcount}));
$hitcount = 0;
foreach (keys(%{$sumcount}))
{
if ($sumcount->{$_} > 0) { $hitcount++; }
}
$data->{"hit"} = $hitcount;
# Get found/hit values for function call data
$data->{"f_found"} = scalar(keys(%{$sumfnccount}));
$hitcount = 0;
foreach (keys(%{$sumfnccount})) {
if ($sumfnccount->{$_} > 0) {
$hitcount++;
}
}
$data->{"f_hit"} = $hitcount;
}
if (scalar(keys(%result)) == 0)
{
die("ERROR: no valid records found in tracefile $tracefile\n");
}
if ($negative)
{
warn("WARNING: negative counts found in tracefile ".
"$tracefile\n");
}
if ($changed_testname)
{
warn("WARNING: invalid characters removed from testname in ".
"tracefile $tracefile\n");
}
return(\%result);
}
#
# get_info_entry(hash_ref)
#
# Retrieve data from an entry of the structure generated by read_info_file().
# Return a list of references to hashes:
# (test data hash ref, sum count hash ref, funcdata hash ref, checkdata hash
# ref, testfncdata hash ref, sumfnccount hash ref, lines found, lines hit,
# functions found, functions hit)
#
sub get_info_entry($)
{
my $testdata_ref = $_[0]->{"test"};
my $sumcount_ref = $_[0]->{"sum"};
my $funcdata_ref = $_[0]->{"func"};
my $checkdata_ref = $_[0]->{"check"};
my $testfncdata = $_[0]->{"testfnc"};
my $sumfnccount = $_[0]->{"sumfnc"};
my $lines_found = $_[0]->{"found"};
my $lines_hit = $_[0]->{"hit"};
my $f_found = $_[0]->{"f_found"};
my $f_hit = $_[0]->{"f_hit"};
return ($testdata_ref, $sumcount_ref, $funcdata_ref, $checkdata_ref,
$testfncdata, $sumfnccount, $lines_found, $lines_hit,
$f_found, $f_hit);
}
#
# set_info_entry(hash_ref, testdata_ref, sumcount_ref, funcdata_ref,
# checkdata_ref, testfncdata_ref, sumfcncount_ref[,lines_found,
# lines_hit, f_found, f_hit])
#
# Update the hash referenced by HASH_REF with the provided data references.
#
sub set_info_entry($$$$$$$;$$$$)
{
my $data_ref = $_[0];
$data_ref->{"test"} = $_[1];
$data_ref->{"sum"} = $_[2];
$data_ref->{"func"} = $_[3];
$data_ref->{"check"} = $_[4];
$data_ref->{"testfnc"} = $_[5];
$data_ref->{"sumfnc"} = $_[6];
if (defined($_[7])) { $data_ref->{"found"} = $_[7]; }
if (defined($_[8])) { $data_ref->{"hit"} = $_[8]; }
if (defined($_[9])) { $data_ref->{"f_found"} = $_[9]; }
if (defined($_[10])) { $data_ref->{"f_hit"} = $_[10]; }
}
#
# add_counts(data1_ref, data2_ref)
#
# DATA1_REF and DATA2_REF are references to hashes containing a mapping
#
# line number -> execution count
#
# Return a list (RESULT_REF, LINES_FOUND, LINES_HIT) where RESULT_REF
# is a reference to a hash containing the combined mapping in which
# execution counts are added.
#
sub add_counts($$)
{
my %data1 = %{$_[0]}; # Hash 1
my %data2 = %{$_[1]}; # Hash 2
my %result; # Resulting hash
my $line; # Current line iteration scalar
my $data1_count; # Count of line in hash1
my $data2_count; # Count of line in hash2
my $found = 0; # Total number of lines found
my $hit = 0; # Number of lines with a count > 0
foreach $line (keys(%data1))
{
$data1_count = $data1{$line};
$data2_count = $data2{$line};
# Add counts if present in both hashes
if (defined($data2_count)) { $data1_count += $data2_count; }
# Store sum in %result
$result{$line} = $data1_count;
$found++;
if ($data1_count > 0) { $hit++; }
}
# Add lines unique to data2
foreach $line (keys(%data2))
{
# Skip lines already in data1
if (defined($data1{$line})) { next; }
# Copy count from data2
$result{$line} = $data2{$line};
$found++;
if ($result{$line} > 0) { $hit++; }
}
return (\%result, $found, $hit);
}
#
# merge_checksums(ref1, ref2, filename)
#
# REF1 and REF2 are references to hashes containing a mapping
#
# line number -> checksum
#
# Merge checksum lists defined in REF1 and REF2 and return reference to
# resulting hash. Die if a checksum for a line is defined in both hashes
# but does not match.
#
sub merge_checksums($$$)
{
my $ref1 = $_[0];
my $ref2 = $_[1];
my $filename = $_[2];
my %result;
my $line;
foreach $line (keys(%{$ref1}))
{
if (defined($ref2->{$line}) &&
($ref1->{$line} ne $ref2->{$line}))
{
die("ERROR: checksum mismatch at $filename:$line\n");
}
$result{$line} = $ref1->{$line};
}
foreach $line (keys(%{$ref2}))
{
$result{$line} = $ref2->{$line};
}
return \%result;
}
#
# merge_func_data(funcdata1, funcdata2, filename)
#
sub merge_func_data($$$)
{
my ($funcdata1, $funcdata2, $filename) = @_;
my %result;
my $func;
%result = %{$funcdata1};
foreach $func (keys(%{$funcdata2})) {
my $line1 = $result{$func};
my $line2 = $funcdata2->{$func};
if (defined($line1) && ($line1 != $line2)) {
warn("WARNING: function data mismatch at ".
"$filename:$line2\n");
next;
}
$result{$func} = $line2;
}
return \%result;
}
#
# add_fnccount(fnccount1, fnccount2)
#
# Add function call count data. Return list (fnccount_added, f_found, f_hit)
#
sub add_fnccount($$)
{
my ($fnccount1, $fnccount2) = @_;
my %result;
my $f_found;
my $f_hit;
my $function;
%result = %{$fnccount1};
foreach $function (keys(%{$fnccount2})) {
$result{$function} += $fnccount2->{$function};
}
$f_found = scalar(keys(%result));
$f_hit = 0;
foreach $function (keys(%result)) {
if ($result{$function} > 0) {
$f_hit++;
}
}
return (\%result, $f_found, $f_hit);
}
#
# add_testfncdata(testfncdata1, testfncdata2)
#
# Add function call count data for several tests. Return reference to
# added_testfncdata.
#
sub add_testfncdata($$)
{
my ($testfncdata1, $testfncdata2) = @_;
my %result;
my $testname;
foreach $testname (keys(%{$testfncdata1})) {
if (defined($testfncdata2->{$testname})) {
my $fnccount;
# Function call count data for this testname exists
# in both data sets: merge
($fnccount) = add_fnccount(
$testfncdata1->{$testname},
$testfncdata2->{$testname});
$result{$testname} = $fnccount;
next;
}
# Function call count data for this testname is unique to
# data set 1: copy
$result{$testname} = $testfncdata1->{$testname};
}
# Add count data for testnames unique to data set 2
foreach $testname (keys(%{$testfncdata2})) {
if (!defined($result{$testname})) {
$result{$testname} = $testfncdata2->{$testname};
}
}
return \%result;
}
#
# combine_info_entries(entry_ref1, entry_ref2, filename)
#
# Combine .info data entry hashes referenced by ENTRY_REF1 and ENTRY_REF2.
# Return reference to resulting hash.
#
sub combine_info_entries($$$)
{
my $entry1 = $_[0]; # Reference to hash containing first entry
my $testdata1;
my $sumcount1;
my $funcdata1;
my $checkdata1;
my $testfncdata1;
my $sumfnccount1;
my $entry2 = $_[1]; # Reference to hash containing second entry
my $testdata2;
my $sumcount2;
my $funcdata2;
my $checkdata2;
my $testfncdata2;
my $sumfnccount2;
my %result; # Hash containing combined entry
my %result_testdata;
my $result_sumcount = {};
my $result_funcdata;
my $result_testfncdata;
my $result_sumfnccount;
my $lines_found;
my $lines_hit;
my $f_found;
my $f_hit;
my $testname;
my $filename = $_[2];
# Retrieve data
($testdata1, $sumcount1, $funcdata1, $checkdata1, $testfncdata1,
$sumfnccount1) = get_info_entry($entry1);
($testdata2, $sumcount2, $funcdata2, $checkdata2, $testfncdata2,
$sumfnccount2) = get_info_entry($entry2);
# Merge checksums
$checkdata1 = merge_checksums($checkdata1, $checkdata2, $filename);
# Combine funcdata
$result_funcdata = merge_func_data($funcdata1, $funcdata2, $filename);
# Combine function call count data
$result_testfncdata = add_testfncdata($testfncdata1, $testfncdata2);
($result_sumfnccount, $f_found, $f_hit) =
add_fnccount($sumfnccount1, $sumfnccount2);
# Combine testdata
foreach $testname (keys(%{$testdata1}))
{
if (defined($testdata2->{$testname}))
{
# testname is present in both entries, requires
# combination
($result_testdata{$testname}) =
add_counts($testdata1->{$testname},
$testdata2->{$testname});
}
else
{
# testname only present in entry1, add to result
$result_testdata{$testname} = $testdata1->{$testname};
}
# update sum count hash
($result_sumcount, $lines_found, $lines_hit) =
add_counts($result_sumcount,
$result_testdata{$testname});
}
foreach $testname (keys(%{$testdata2}))
{
# Skip testnames already covered by previous iteration
if (defined($testdata1->{$testname})) { next; }
# testname only present in entry2, add to result hash
$result_testdata{$testname} = $testdata2->{$testname};
# update sum count hash
($result_sumcount, $lines_found, $lines_hit) =
add_counts($result_sumcount,
$result_testdata{$testname});
}
# Calculate resulting sumcount
# Store result
set_info_entry(\%result, \%result_testdata, $result_sumcount,
$result_funcdata, $checkdata1, $result_testfncdata,
$result_sumfnccount, $lines_found, $lines_hit,
$f_found, $f_hit);
return(\%result);
}
#
# combine_info_files(info_ref1, info_ref2)
#
# Combine .info data in hashes referenced by INFO_REF1 and INFO_REF2. Return
# reference to resulting hash.
#
sub combine_info_files($$)
{
my %hash1 = %{$_[0]};
my %hash2 = %{$_[1]};
my $filename;
foreach $filename (keys(%hash2))
{
if ($hash1{$filename})
{
# Entry already exists in hash1, combine them
$hash1{$filename} =
combine_info_entries($hash1{$filename},
$hash2{$filename},
$filename);
}
else
{
# Entry is unique in both hashes, simply add to
# resulting hash
$hash1{$filename} = $hash2{$filename};
}
}
return(\%hash1);
}
#
# add_traces()
#
sub add_traces()
{
my $total_trace;
my $current_trace;
my $tracefile;
local *INFO_HANDLE;
info("Combining tracefiles.\n");
foreach $tracefile (@add_tracefile)
{
$current_trace = read_info_file($tracefile);
if ($total_trace)
{
$total_trace = combine_info_files($total_trace,
$current_trace);
}
else
{
$total_trace = $current_trace;
}
}
# Write combined data
if ($to_file)
{
info("Writing data to $output_filename\n");
open(INFO_HANDLE, ">$output_filename")
or die("ERROR: cannot write to $output_filename!\n");
write_info_file(*INFO_HANDLE, $total_trace);
close(*INFO_HANDLE);
}
else
{
write_info_file(*STDOUT, $total_trace);
}
}
#
# write_info_file(filehandle, data)
#
sub write_info_file(*$)
{
local *INFO_HANDLE = $_[0];
my %data = %{$_[1]};
my $source_file;
my $entry;
my $testdata;
my $sumcount;
my $funcdata;
my $checkdata;
my $testfncdata;
my $sumfnccount;
my $testname;
my $line;
my $func;
my $testcount;
my $testfnccount;
my $found;
my $hit;
my $f_found;
my $f_hit;
foreach $source_file (keys(%data))
{
$entry = $data{$source_file};
($testdata, $sumcount, $funcdata, $checkdata, $testfncdata,
$sumfnccount) = get_info_entry($entry);
foreach $testname (keys(%{$testdata}))
{
$testcount = $testdata->{$testname};
$testfnccount = $testfncdata->{$testname};
$found = 0;
$hit = 0;
print(INFO_HANDLE "TN:$testname\n");
print(INFO_HANDLE "SF:$source_file\n");
# Write function related data
foreach $func (
sort({$funcdata->{$a} <=> $funcdata->{$b}}
keys(%{$funcdata})))
{
print(INFO_HANDLE "FN:".$funcdata->{$func}.
",$func\n");
}
foreach $func (keys(%{$testfnccount})) {
print(INFO_HANDLE "FNDA:".
$testfnccount->{$func}.
",$func\n");
}
($f_found, $f_hit) =
get_func_found_and_hit($testfnccount);
print(INFO_HANDLE "FNF:$f_found\n");
print(INFO_HANDLE "FNH:$f_hit\n");
# Write line related data
foreach $line (sort({$a <=> $b} keys(%{$testcount})))
{
print(INFO_HANDLE "DA:$line,".
$testcount->{$line}.
(defined($checkdata->{$line}) &&
$checksum ?
",".$checkdata->{$line} : "")."\n");
$found++;
if ($testcount->{$line} > 0)
{
$hit++;
}
}
print(INFO_HANDLE "LF:$found\n");
print(INFO_HANDLE "LH:$hit\n");
print(INFO_HANDLE "end_of_record\n");
}
}
}
#
# transform_pattern(pattern)
#
# Transform shell wildcard expression to equivalent PERL regular expression.
# Return transformed pattern.
#
sub transform_pattern($)
{
my $pattern = $_[0];
# Escape special chars
$pattern =~ s/\\/\\\\/g;
$pattern =~ s/\//\\\//g;
$pattern =~ s/\^/\\\^/g;
$pattern =~ s/\$/\\\$/g;
$pattern =~ s/\(/\\\(/g;
$pattern =~ s/\)/\\\)/g;
$pattern =~ s/\[/\\\[/g;
$pattern =~ s/\]/\\\]/g;
$pattern =~ s/\{/\\\{/g;
$pattern =~ s/\}/\\\}/g;
$pattern =~ s/\./\\\./g;
$pattern =~ s/\,/\\\,/g;
$pattern =~ s/\|/\\\|/g;
$pattern =~ s/\+/\\\+/g;
$pattern =~ s/\!/\\\!/g;
# Transform ? => (.) and * => (.*)
$pattern =~ s/\*/\(\.\*\)/g;
$pattern =~ s/\?/\(\.\)/g;
return $pattern;
}
#
# extract()
#
sub extract()
{
my $data = read_info_file($extract);
my $filename;
my $keep;
my $pattern;
my @pattern_list;
my $extracted = 0;
local *INFO_HANDLE;
# Need perlreg expressions instead of shell pattern
@pattern_list = map({ transform_pattern($_); } @ARGV);
# Filter out files which do not match any pattern
foreach $filename (sort(keys(%{$data})))
{
$keep = 0;
foreach $pattern (@pattern_list)
{
$keep ||= ($filename =~ (/^$pattern$/));
}
if (!$keep)
{
delete($data->{$filename});
}
else
{
info("Extracting $filename\n"),
$extracted++;
}
}
# Write extracted data
if ($to_file)
{
info("Extracted $extracted files\n");
info("Writing data to $output_filename\n");
open(INFO_HANDLE, ">$output_filename")
or die("ERROR: cannot write to $output_filename!\n");
write_info_file(*INFO_HANDLE, $data);
close(*INFO_HANDLE);
}
else
{
write_info_file(*STDOUT, $data);
}
}
#
# remove()
#
sub remove()
{
my $data = read_info_file($remove);
my $filename;
my $match_found;
my $pattern;
my @pattern_list;
my $removed = 0;
local *INFO_HANDLE;
# Need perlreg expressions instead of shell pattern
@pattern_list = map({ transform_pattern($_); } @ARGV);
# Filter out files that match the pattern
foreach $filename (sort(keys(%{$data})))
{
$match_found = 0;
foreach $pattern (@pattern_list)
{
$match_found ||= ($filename =~ (/$pattern$/));
}
if ($match_found)
{
delete($data->{$filename});
info("Removing $filename\n"),
$removed++;
}
}
# Write data
if ($to_file)
{
info("Deleted $removed files\n");
info("Writing data to $output_filename\n");
open(INFO_HANDLE, ">$output_filename")
or die("ERROR: cannot write to $output_filename!\n");
write_info_file(*INFO_HANDLE, $data);
close(*INFO_HANDLE);
}
else
{
write_info_file(*STDOUT, $data);
}
}
#
# list()
#
sub list()
{
my $data = read_info_file($list);
my $filename;
my $found;
my $hit;
my $entry;
info("Listing contents of $list:\n");
# List all files
foreach $filename (sort(keys(%{$data})))
{
$entry = $data->{$filename};
(undef, undef, undef, undef, undef, undef, $found, $hit) =
get_info_entry($entry);
printf("$filename: $hit of $found lines hit\n");
}
}
#
# get_common_filename(filename1, filename2)
#
# Check for filename components which are common to FILENAME1 and FILENAME2.
# Upon success, return
#
# (common, path1, path2)
#
# or 'undef' in case there are no such parts.
#
sub get_common_filename($$)
{
my @list1 = split("/", $_[0]);
my @list2 = split("/", $_[1]);
my @result;
# Work in reverse order, i.e. beginning with the filename itself
while (@list1 && @list2 && ($list1[$#list1] eq $list2[$#list2]))
{
unshift(@result, pop(@list1));
pop(@list2);
}
# Did we find any similarities?
if (scalar(@result) > 0)
{
return (join("/", @result), join("/", @list1),
join("/", @list2));
}
else
{
return undef;
}
}
#
# strip_directories($path, $depth)
#
# Remove DEPTH leading directory levels from PATH.
#
sub strip_directories($$)
{
my $filename = $_[0];
my $depth = $_[1];
my $i;
if (!defined($depth) || ($depth < 1))
{
return $filename;
}
for ($i = 0; $i < $depth; $i++)
{
$filename =~ s/^[^\/]*\/+(.*)$/$1/;
}
return $filename;
}
#
# read_diff(filename)
#
# Read diff output from FILENAME to memory. The diff file has to follow the
# format generated by 'diff -u'. Returns a list of hash references:
#
# (mapping, path mapping)
#
# mapping: filename -> reference to line hash
# line hash: line number in new file -> corresponding line number in old file
#
# path mapping: filename -> old filename
#
# Die in case of error.
#
sub read_diff($)
{
my $diff_file = $_[0]; # Name of diff file
my %diff; # Resulting mapping filename -> line hash
my %paths; # Resulting mapping old path -> new path
my $mapping; # Reference to current line hash
my $line; # Contents of current line
my $num_old; # Current line number in old file
my $num_new; # Current line number in new file
my $file_old; # Name of old file in diff section
my $file_new; # Name of new file in diff section
my $filename; # Name of common filename of diff section
my $in_block = 0; # Non-zero while we are inside a diff block
local *HANDLE; # File handle for reading the diff file
info("Reading diff $diff_file\n");
# Check if file exists and is readable
stat($diff_file);
if (!(-r _))
{
die("ERROR: cannot read file $diff_file!\n");
}
# Check if this is really a plain file
if (!(-f _))
{
die("ERROR: not a plain file: $diff_file!\n");
}
# Check for .gz extension
if ($diff_file =~ /\.gz$/)
{
# Check for availability of GZIP tool
system_no_output(1, "gunzip", "-h")
and die("ERROR: gunzip command not available!\n");
# Check integrity of compressed file
system_no_output(1, "gunzip", "-t", $diff_file)
and die("ERROR: integrity check failed for ".
"compressed file $diff_file!\n");
# Open compressed file
open(HANDLE, "gunzip -c $diff_file|")
or die("ERROR: cannot start gunzip to decompress ".
"file $_[0]!\n");
}
else
{
# Open decompressed file
open(HANDLE, $diff_file)
or die("ERROR: cannot read file $_[0]!\n");
}
# Parse diff file line by line
while (<HANDLE>)
{
chomp($_);
$line = $_;
foreach ($line)
{
# Filename of old file:
# --- <filename> <date>
/^--- (\S+)/ && do
{
$file_old = strip_directories($1, $strip);
last;
};
# Filename of new file:
# +++ <filename> <date>
/^\+\+\+ (\S+)/ && do
{
# Add last file to resulting hash
if ($filename)
{
my %new_hash;
$diff{$filename} = $mapping;
$mapping = \%new_hash;
}
$file_new = strip_directories($1, $strip);
$filename = $file_old;
$paths{$filename} = $file_new;
$num_old = 1;
$num_new = 1;
last;
};
# Start of diff block:
# @@ -old_start,old_num, +new_start,new_num @@
/^\@\@\s+-(\d+),(\d+)\s+\+(\d+),(\d+)\s+\@\@$/ && do
{
$in_block = 1;
while ($num_old < $1)
{
$mapping->{$num_new} = $num_old;
$num_old++;
$num_new++;
}
last;
};
# Unchanged line
# <line starts with blank>
/^ / && do
{
if ($in_block == 0)
{
last;
}
$mapping->{$num_new} = $num_old;
$num_old++;
$num_new++;
last;
};
# Line as seen in old file
# <line starts with '-'>
/^-/ && do
{
if ($in_block == 0)
{
last;
}
$num_old++;
last;
};
# Line as seen in new file
# <line starts with '+'>
/^\+/ && do
{
if ($in_block == 0)
{
last;
}
$num_new++;
last;
};
# Empty line
/^$/ && do
{
if ($in_block == 0)
{
last;
}
$mapping->{$num_new} = $num_old;
$num_old++;
$num_new++;
last;
};
}
}
close(HANDLE);
# Add final diff file section to resulting hash
if ($filename)
{
$diff{$filename} = $mapping;
}
if (!%diff)
{
die("ERROR: no valid diff data found in $diff_file!\n".
"Make sure to use 'diff -u' when generating the diff ".
"file.\n");
}
return (\%diff, \%paths);
}
#
# apply_diff($count_data, $line_hash)
#
# Transform count data using a mapping of lines:
#
# $count_data: reference to hash: line number -> data
# $line_hash: reference to hash: line number new -> line number old
#
# Return a reference to transformed count data.
#
sub apply_diff($$)
{
my $count_data = $_[0]; # Reference to data hash: line -> hash
my $line_hash = $_[1]; # Reference to line hash: new line -> old line
my %result; # Resulting hash
my $last_new = 0; # Last new line number found in line hash
my $last_old = 0; # Last old line number found in line hash
# Iterate all new line numbers found in the diff
foreach (sort({$a <=> $b} keys(%{$line_hash})))
{
$last_new = $_;
$last_old = $line_hash->{$last_new};
# Is there data associated with the corresponding old line?
if (defined($count_data->{$line_hash->{$_}}))
{
# Copy data to new hash with a new line number
$result{$_} = $count_data->{$line_hash->{$_}};
}
}
# Transform all other lines which come after the last diff entry
foreach (sort({$a <=> $b} keys(%{$count_data})))
{
if ($_ <= $last_old)
{
# Skip lines which were covered by line hash
next;
}
# Copy data to new hash with an offset
$result{$_ + ($last_new - $last_old)} = $count_data->{$_};
}
return \%result;
}
#
# get_hash_max(hash_ref)
#
# Return the highest integer key from hash.
#
sub get_hash_max($)
{
my ($hash) = @_;
my $max;
foreach (keys(%{$hash})) {
if (!defined($max)) {
$max = $_;
} elsif ($hash->{$_} > $max) {
$max = $_;
}
}
return $max;
}
sub get_hash_reverse($)
{
my ($hash) = @_;
my %result;
foreach (keys(%{$hash})) {
$result{$hash->{$_}} = $_;
}
return \%result;
}
#
# apply_diff_to_funcdata(funcdata, line_hash)
#
sub apply_diff_to_funcdata($$)
{
my ($funcdata, $linedata) = @_;
my $last_new = get_hash_max($linedata);
my $last_old = $linedata->{$last_new};
my $func;
my %result;
my $line_diff = get_hash_reverse($linedata);
foreach $func (keys(%{$funcdata})) {
my $line = $funcdata->{$func};
if (defined($line_diff->{$line})) {
$result{$func} = $line_diff->{$line};
} elsif ($line > $last_old) {
$result{$func} = $line + $last_new - $last_old;
}
}
return \%result;
}
#
# get_line_hash($filename, $diff_data, $path_data)
#
# Find line hash in DIFF_DATA which matches FILENAME. On success, return list
# line hash. or undef in case of no match. Die if more than one line hashes in
# DIFF_DATA match.
#
sub get_line_hash($$$)
{
my $filename = $_[0];
my $diff_data = $_[1];
my $path_data = $_[2];
my $conversion;
my $old_path;
my $new_path;
my $diff_name;
my $common;
my $old_depth;
my $new_depth;
foreach (keys(%{$diff_data}))
{
# Try to match diff filename with filename
if ($filename =~ /^\Q$diff_path\E\/$_$/)
{
if ($diff_name)
{
# Two files match, choose the more specific one
# (the one with more path components)
$old_depth = ($diff_name =~ tr/\///);
$new_depth = (tr/\///);
if ($old_depth == $new_depth)
{
die("ERROR: diff file contains ".
"ambiguous entries for ".
"$filename\n");
}
elsif ($new_depth > $old_depth)
{
$diff_name = $_;
}
}
else
{
$diff_name = $_;
}
};
}
if ($diff_name)
{
# Get converted path
if ($filename =~ /^(.*)$diff_name$/)
{
($common, $old_path, $new_path) =
get_common_filename($filename,
$1.$path_data->{$diff_name});
}
return ($diff_data->{$diff_name}, $old_path, $new_path);
}
else
{
return undef;
}
}
#
# convert_paths(trace_data, path_conversion_data)
#
# Rename all paths in TRACE_DATA which show up in PATH_CONVERSION_DATA.
#
sub convert_paths($$)
{
my $trace_data = $_[0];
my $path_conversion_data = $_[1];
my $filename;
my $new_path;
if (scalar(keys(%{$path_conversion_data})) == 0)
{
info("No path conversion data available.\n");
return;
}
# Expand path conversion list
foreach $filename (keys(%{$path_conversion_data}))
{
$new_path = $path_conversion_data->{$filename};
while (($filename =~ s/^(.*)\/[^\/]+$/$1/) &&
($new_path =~ s/^(.*)\/[^\/]+$/$1/) &&
($filename ne $new_path))
{
$path_conversion_data->{$filename} = $new_path;
}
}
# Adjust paths
FILENAME: foreach $filename (keys(%{$trace_data}))
{
# Find a path in our conversion table that matches, starting
# with the longest path
foreach (sort({length($b) <=> length($a)}
keys(%{$path_conversion_data})))
{
# Is this path a prefix of our filename?
if (!($filename =~ /^$_(.*)$/))
{
next;
}
$new_path = $path_conversion_data->{$_}.$1;
# Make sure not to overwrite an existing entry under
# that path name
if ($trace_data->{$new_path})
{
# Need to combine entries
$trace_data->{$new_path} =
combine_info_entries(
$trace_data->{$filename},
$trace_data->{$new_path},
$filename);
}
else
{
# Simply rename entry
$trace_data->{$new_path} =
$trace_data->{$filename};
}
delete($trace_data->{$filename});
next FILENAME;
}
info("No conversion available for filename $filename\n");
}
}
#
# sub adjust_fncdata(funcdata, testfncdata, sumfnccount)
#
# Remove function call count data from testfncdata and sumfnccount which
# is no longer present in funcdata.
#
sub adjust_fncdata($$$)
{
my ($funcdata, $testfncdata, $sumfnccount) = @_;
my $testname;
my $func;
my $f_found;
my $f_hit;
# Remove count data in testfncdata for functions which are no longer
# in funcdata
foreach $testname (%{$testfncdata}) {
my $fnccount = $testfncdata->{$testname};
foreach $func (%{$fnccount}) {
if (!defined($funcdata->{$func})) {
delete($fnccount->{$func});
}
}
}
# Remove count data in sumfnccount for functions which are no longer
# in funcdata
foreach $func (%{$sumfnccount}) {
if (!defined($funcdata->{$func})) {
delete($sumfnccount->{$func});
}
}
}
#
# get_func_found_and_hit(sumfnccount)
#
# Return (f_found, f_hit) for sumfnccount
#
sub get_func_found_and_hit($)
{
my ($sumfnccount) = @_;
my $function;
my $f_found;
my $f_hit;
$f_found = scalar(keys(%{$sumfnccount}));
$f_hit = 0;
foreach $function (keys(%{$sumfnccount})) {
if ($sumfnccount->{$function} > 0) {
$f_hit++;
}
}
return ($f_found, $f_hit);
}
#
# diff()
#
sub diff()
{
my $trace_data = read_info_file($diff);
my $diff_data;
my $path_data;
my $old_path;
my $new_path;
my %path_conversion_data;
my $filename;
my $line_hash;
my $new_name;
my $entry;
my $testdata;
my $testname;
my $sumcount;
my $funcdata;
my $checkdata;
my $testfncdata;
my $sumfnccount;
my $found;
my $hit;
my $f_found;
my $f_hit;
my $converted = 0;
my $unchanged = 0;
local *INFO_HANDLE;
($diff_data, $path_data) = read_diff($ARGV[0]);
foreach $filename (sort(keys(%{$trace_data})))
{
# Find a diff section corresponding to this file
($line_hash, $old_path, $new_path) =
get_line_hash($filename, $diff_data, $path_data);
if (!$line_hash)
{
# There's no diff section for this file
$unchanged++;
next;
}
$converted++;
if ($old_path && $new_path && ($old_path ne $new_path))
{
$path_conversion_data{$old_path} = $new_path;
}
# Check for deleted files
if (scalar(keys(%{$line_hash})) == 0)
{
info("Removing $filename\n");
delete($trace_data->{$filename});
next;
}
info("Converting $filename\n");
$entry = $trace_data->{$filename};
($testdata, $sumcount, $funcdata, $checkdata, $testfncdata,
$sumfnccount) = get_info_entry($entry);
# Convert test data
foreach $testname (keys(%{$testdata}))
{
$testdata->{$testname} =
apply_diff($testdata->{$testname}, $line_hash);
# Remove empty sets of test data
if (scalar(keys(%{$testdata->{$testname}})) == 0)
{
delete($testdata->{$testname});
delete($testfncdata->{$testname});
}
}
# Rename test data to indicate conversion
foreach $testname (keys(%{$testdata}))
{
# Skip testnames which already contain an extension
if ($testname =~ /,[^,]+$/)
{
next;
}
# Check for name conflict
if (defined($testdata->{$testname.",diff"}))
{
# Add counts
($testdata->{$testname}) = add_counts(
$testdata->{$testname},
$testdata->{$testname.",diff"});
delete($testdata->{$testname.",diff"});
# Add function call counts
($testfncdata->{$testname}) = add_fnccount(
$testfncdata->{$testname},
$testfncdata->{$testname.",diff"});
delete($testfncdata->{$testname.",diff"});
}
# Move test data to new testname
$testdata->{$testname.",diff"} = $testdata->{$testname};
delete($testdata->{$testname});
# Move function call count data to new testname
$testfncdata->{$testname.",diff"} =
$testfncdata->{$testname};
delete($testfncdata->{$testname});
}
# Convert summary of test data
$sumcount = apply_diff($sumcount, $line_hash);
# Convert function data
$funcdata = apply_diff_to_funcdata($funcdata, $line_hash);
# Convert checksum data
$checkdata = apply_diff($checkdata, $line_hash);
# Convert function call count data
adjust_fncdata($funcdata, $testfncdata, $sumfnccount);
($f_found, $f_hit) = get_func_found_and_hit($sumfnccount);
# Update found/hit numbers
$found = 0;
$hit = 0;
foreach (keys(%{$sumcount}))
{
$found++;
if ($sumcount->{$_} > 0)
{
$hit++;
}
}
if ($found > 0)
{
# Store converted entry
set_info_entry($entry, $testdata, $sumcount, $funcdata,
$checkdata, $testfncdata, $sumfnccount,
$found, $hit, $f_found, $f_hit);
}
else
{
# Remove empty data set
delete($trace_data->{$filename});
}
}
# Convert filenames as well if requested
if ($convert_filenames)
{
convert_paths($trace_data, \%path_conversion_data);
}
info("$converted entr".($converted != 1 ? "ies" : "y")." converted, ".
"$unchanged entr".($unchanged != 1 ? "ies" : "y")." left ".
"unchanged.\n");
# Write data
if ($to_file)
{
info("Writing data to $output_filename\n");
open(INFO_HANDLE, ">$output_filename")
or die("ERROR: cannot write to $output_filename!\n");
write_info_file(*INFO_HANDLE, $trace_data);
close(*INFO_HANDLE);
}
else
{
write_info_file(*STDOUT, $trace_data);
}
}
#
# 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 warn_handler($)
{
my ($msg) = @_;
warn("$tool_name: $msg");
}
sub die_handler($)
{
my ($msg) = @_;
die("$tool_name: $msg");
}