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