Swiftdiff options
| author | Remko Tronçon <git@el-tramo.be> | 2010-02-12 20:54:23 (GMT) |
|---|---|---|
| committer | Remko Tronçon <git@el-tramo.be> | 2010-02-12 20:54:23 (GMT) |
| commit | 231c2cb6d00061e70860626467107f4c63f359a0 (patch) | |
| tree | c3ab479f071e882030d6b2fc6d2e3d88b25d16fe /3rdParty/LCov/lcov | |
| parent | 0efa7c32aaf21a29b42b5926cc116007056843be (diff) | |
| download | swift-contrib-231c2cb6d00061e70860626467107f4c63f359a0.zip swift-contrib-231c2cb6d00061e70860626467107f4c63f359a0.tar.bz2 | |
Creating more submodules.
Diffstat (limited to '3rdParty/LCov/lcov')
| m--------- | 3rdParty/LCov | 0 | ||||
| -rwxr-xr-x | 3rdParty/LCov/lcov | 2699 |
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"); -} |