diff options
author | Remko Tronçon <git@el-tramo.be> | 2010-03-28 15:46:49 (GMT) |
---|---|---|
committer | Remko Tronçon <git@el-tramo.be> | 2010-03-28 15:46:49 (GMT) |
commit | f53a1ef582494458301b97bf6e546be52d7ff7e8 (patch) | |
tree | 7571b5cbcbd8a8f1dd1c966c9045b6cb69f0e295 /3rdParty/LCov/geninfo | |
parent | 638345680d72ca6acaf123f2c8c1c391f696e371 (diff) | |
download | swift-contrib-f53a1ef582494458301b97bf6e546be52d7ff7e8.zip swift-contrib-f53a1ef582494458301b97bf6e546be52d7ff7e8.tar.bz2 |
Moving submodule contents back.
Diffstat (limited to '3rdParty/LCov/geninfo')
-rwxr-xr-x | 3rdParty/LCov/geninfo | 2178 |
1 files changed, 2178 insertions, 0 deletions
diff --git a/3rdParty/LCov/geninfo b/3rdParty/LCov/geninfo new file mode 100755 index 0000000..055641b --- /dev/null +++ b/3rdParty/LCov/geninfo @@ -0,0 +1,2178 @@ +#!/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"); +} |