summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRemko Tronçon <git@el-tramo.be>2010-02-12 20:54:23 (GMT)
committerRemko Tronçon <git@el-tramo.be>2010-02-12 20:54:23 (GMT)
commit231c2cb6d00061e70860626467107f4c63f359a0 (patch)
treec3ab479f071e882030d6b2fc6d2e3d88b25d16fe /3rdParty/LCov/lcov
parent0efa7c32aaf21a29b42b5926cc116007056843be (diff)
downloadswift-contrib-231c2cb6d00061e70860626467107f4c63f359a0.zip
swift-contrib-231c2cb6d00061e70860626467107f4c63f359a0.tar.bz2
Creating more submodules.
Diffstat (limited to '3rdParty/LCov/lcov')
m---------3rdParty/LCov0
-rwxr-xr-x3rdParty/LCov/lcov2699
2 files changed, 0 insertions, 2699 deletions
diff --git a/3rdParty/LCov b/3rdParty/LCov
new file mode 160000
+Subproject b851fd65b7ca12fcdfa824358612cf1138f5b73
diff --git a/3rdParty/LCov/lcov b/3rdParty/LCov/lcov
deleted file mode 100755
index 6304d75..0000000
--- a/3rdParty/LCov/lcov
+++ /dev/null
@@ -1,2699 +0,0 @@
-#!/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");
-}