#!/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"); }