#!/usr/bin/perl -w # # Copyright (c) International Business Machines Corp., 2002,2007 # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or (at # your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # # lcov # # This is a wrapper script which provides a single interface for accessing # LCOV coverage data. # # # History: # 2002-08-29 created by Peter Oberparleiter # IBM Lab Boeblingen # 2002-09-05 / Peter Oberparleiter: implemented --kernel-directory + # multiple directories # 2002-10-16 / Peter Oberparleiter: implemented --add-tracefile option # 2002-10-17 / Peter Oberparleiter: implemented --extract option # 2002-11-04 / Peter Oberparleiter: implemented --list option # 2003-03-07 / Paul Larson: Changed to make it work with the latest gcov # kernel patch. This will break it with older gcov-kernel # patches unless you change the value of $gcovmod in this script # 2003-04-07 / Peter Oberparleiter: fixed bug which resulted in an error # when trying to combine .info files containing data without # a test name # 2003-04-10 / Peter Oberparleiter: extended Paul's change so that LCOV # works both with the new and the old gcov-kernel patch # 2003-04-10 / Peter Oberparleiter: added $gcov_dir constant in anticipation # of a possible move of the gcov kernel directory to another # file system in a future version of the gcov-kernel patch # 2003-04-15 / Paul Larson: make info write to STDERR, not STDOUT # 2003-04-15 / Paul Larson: added --remove option # 2003-04-30 / Peter Oberparleiter: renamed --reset to --zerocounters # to remove naming ambiguity with --remove # 2003-04-30 / Peter Oberparleiter: adjusted help text to include --remove # 2003-06-27 / Peter Oberparleiter: implemented --diff # 2003-07-03 / Peter Oberparleiter: added line checksum support, added # --no-checksum # 2003-12-11 / Laurent Deniel: added --follow option # 2004-03-29 / Peter Oberparleiter: modified --diff option to better cope with # ambiguous patch file entries, modified --capture option to use # modprobe before insmod (needed for 2.6) # 2004-03-30 / Peter Oberparleiter: added --path option # 2004-08-09 / Peter Oberparleiter: added configuration file support # 2008-08-13 / Peter Oberparleiter: added function coverage support # use strict; use File::Basename; use Getopt::Long; # Global constants our $lcov_version = "LCOV version 1.7"; our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php"; our $tool_name = basename($0); # Names of the GCOV kernel module our @gcovmod = ("gcov-prof", "gcov-proc"); # Directory containing gcov kernel files our $gcov_dir = "/proc/gcov"; # The location of the insmod tool our $insmod_tool = "/sbin/insmod"; # The location of the modprobe tool our $modprobe_tool = "/sbin/modprobe"; # The location of the rmmod tool our $rmmod_tool = "/sbin/rmmod"; # Where to create temporary directories our $tmp_dir = "/tmp"; # How to prefix a temporary directory name our $tmp_prefix = "tmpdir"; # Prototypes sub print_usage(*); sub check_options(); sub userspace_reset(); sub userspace_capture(); sub kernel_reset(); sub kernel_capture(); sub add_traces(); sub read_info_file($); sub get_info_entry($); sub set_info_entry($$$$$$$;$$$$); sub add_counts($$); sub merge_checksums($$$); sub combine_info_entries($$$); sub combine_info_files($$); sub write_info_file(*$); sub extract(); sub remove(); sub list(); sub get_common_filename($$); sub read_diff($); sub diff(); sub system_no_output($@); sub read_config($); sub apply_config($); sub info(@); sub unload_module($); sub check_and_load_kernel_module(); sub create_temp_dir(); sub transform_pattern($); sub warn_handler($); sub die_handler($); # Global variables & initialization our @directory; # Specifies where to get coverage data from our @kernel_directory; # If set, captures only from specified kernel subdirs our @add_tracefile; # If set, reads in and combines all files in list our $list; # If set, list contents of tracefile our $extract; # If set, extracts parts of tracefile our $remove; # If set, removes parts of tracefile our $diff; # If set, modifies tracefile according to diff our $reset; # If set, reset all coverage data to zero our $capture; # If set, capture data our $output_filename; # Name for file to write coverage data to our $test_name = ""; # Test case name our $quiet = ""; # If set, suppress information messages our $help; # Help option flag our $version; # Version option flag our $convert_filenames; # If set, convert filenames when applying diff our $strip; # If set, strip leading directories when applying diff our $need_unload; # If set, unload gcov kernel module our $temp_dir_name; # Name of temporary directory our $cwd = `pwd`; # Current working directory our $to_file; # If set, indicates that output is written to a file our $follow; # If set, indicates that find shall follow links our $diff_path = ""; # Path removed from tracefile when applying diff our $base_directory; # Base directory (cwd of gcc during compilation) our $checksum; # If set, calculate a checksum for each line our $no_checksum; # If set, don't calculate a checksum for each line our $compat_libtool; # If set, indicates that libtool mode is to be enabled our $no_compat_libtool; # If set, indicates that libtool mode is to be disabled our $gcov_tool; our $ignore_errors; our $initial; our $no_recursion = 0; our $maxdepth; our $config; # Configuration file contents chomp($cwd); our $tool_dir = dirname($0); # Directory where genhtml tool is installed # # Code entry point # $SIG{__WARN__} = \&warn_handler; $SIG{__DIE__} = \&die_handler; # Add current working directory if $tool_dir is not already an absolute path if (! ($tool_dir =~ /^\/(.*)$/)) { $tool_dir = "$cwd/$tool_dir"; } # Read configuration file if available if (-r $ENV{"HOME"}."/.lcovrc") { $config = read_config($ENV{"HOME"}."/.lcovrc"); } elsif (-r "/etc/lcovrc") { $config = read_config("/etc/lcovrc"); } if ($config) { # Copy configuration file values to variables apply_config({ "lcov_gcov_dir" => \$gcov_dir, "lcov_insmod_tool" => \$insmod_tool, "lcov_modprobe_tool" => \$modprobe_tool, "lcov_rmmod_tool" => \$rmmod_tool, "lcov_tmp_dir" => \$tmp_dir}); } # Parse command line options if (!GetOptions("directory|d|di=s" => \@directory, "add-tracefile=s" => \@add_tracefile, "list=s" => \$list, "kernel-directory=s" => \@kernel_directory, "extract=s" => \$extract, "remove=s" => \$remove, "diff=s" => \$diff, "convert-filenames" => \$convert_filenames, "strip=i" => \$strip, "capture|c" => \$capture, "output-file=s" => \$output_filename, "test-name=s" => \$test_name, "zerocounters" => \$reset, "quiet" => \$quiet, "help|?" => \$help, "version" => \$version, "follow" => \$follow, "path=s" => \$diff_path, "base-directory=s" => \$base_directory, "checksum" => \$checksum, "no-checksum" => \$no_checksum, "compat-libtool" => \$compat_libtool, "no-compat-libtool" => \$no_compat_libtool, "gcov-tool=s" => \$gcov_tool, "ignore-errors=s" => \$ignore_errors, "initial|i" => \$initial, "no-recursion" => \$no_recursion )) { print(STDERR "Use $tool_name --help to get usage information\n"); exit(1); } else { # Merge options if (defined($no_checksum)) { $checksum = ($no_checksum ? 0 : 1); $no_checksum = undef; } if (defined($no_compat_libtool)) { $compat_libtool = ($no_compat_libtool ? 0 : 1); $no_compat_libtool = undef; } } # Check for help option if ($help) { print_usage(*STDOUT); exit(0); } # Check for version option if ($version) { print("$tool_name: $lcov_version\n"); exit(0); } # Normalize --path text $diff_path =~ s/\/$//; if ($follow) { $follow = "-follow"; } else { $follow = ""; } if ($no_recursion) { $maxdepth = "-maxdepth 1"; } else { $maxdepth = ""; } # Check for valid options check_options(); # Only --extract, --remove and --diff allow unnamed parameters if (@ARGV && !($extract || $remove || $diff)) { die("Extra parameter found\n". "Use $tool_name --help to get usage information\n"); } # Check for output filename $to_file = ($output_filename && ($output_filename ne "-")); if ($capture) { if (!$to_file) { # Option that tells geninfo to write to stdout $output_filename = "-"; } } else { if ($initial) { die("Option --initial is only valid when capturing data (-c)\n". "Use $tool_name --help to get usage information\n"); } } # Check for requested functionality if ($reset) { # Differentiate between user space and kernel reset if (@directory) { userspace_reset(); } else { kernel_reset(); } } elsif ($capture) { # Differentiate between user space and kernel if (@directory) { userspace_capture(); } else { kernel_capture(); } } elsif (@add_tracefile) { add_traces(); } elsif ($remove) { remove(); } elsif ($extract) { extract(); } elsif ($list) { list(); } elsif ($diff) { if (scalar(@ARGV) != 1) { die("ERROR: option --diff requires one additional argument!\n". "Use $tool_name --help to get usage information\n"); } diff(); } info("Done.\n"); exit(0); # # print_usage(handle) # # Print usage information. # sub print_usage(*) { local *HANDLE = $_[0]; print(HANDLE < 1) { die("ERROR: only one of -z, -c, -a, -e, -r, -l or ". "--diff allowed!\n". "Use $tool_name --help to get usage information\n"); } } # # userspace_reset() # # Reset coverage data found in DIRECTORY by deleting all contained .da files. # # Die on error. # sub userspace_reset() { my $current_dir; my @file_list; foreach $current_dir (@directory) { info("Deleting all .da files in $current_dir". ($no_recursion?"\n":" and subdirectories\n")); @file_list = `find "$current_dir" $maxdepth $follow -name \\*\\.da -o -name \\*\\.gcda -type f 2>/dev/null`; chomp(@file_list); foreach (@file_list) { unlink($_) or die("ERROR: cannot remove file $_!\n"); } } } # # userspace_capture() # # Capture coverage data found in DIRECTORY and write it to OUTPUT_FILENAME # if specified, otherwise to STDOUT. # # Die on error. # sub userspace_capture() { my @param; my $file_list = join(" ", @directory); info("Capturing coverage data from $file_list\n"); @param = ("$tool_dir/geninfo", @directory); if ($output_filename) { @param = (@param, "--output-filename", $output_filename); } if ($test_name) { @param = (@param, "--test-name", $test_name); } if ($follow) { @param = (@param, "--follow"); } if ($quiet) { @param = (@param, "--quiet"); } if (defined($checksum)) { if ($checksum) { @param = (@param, "--checksum"); } else { @param = (@param, "--no-checksum"); } } if ($base_directory) { @param = (@param, "--base-directory", $base_directory); } if ($no_compat_libtool) { @param = (@param, "--no-compat-libtool"); } elsif ($compat_libtool) { @param = (@param, "--compat-libtool"); } if ($gcov_tool) { @param = (@param, "--gcov-tool", $gcov_tool); } if ($ignore_errors) { @param = (@param, "--ignore-errors", $ignore_errors); } if ($initial) { @param = (@param, "--initial"); } if ($no_recursion) { @param = (@param, "--no-recursion"); } system(@param); exit($? >> 8); } # # kernel_reset() # # Reset kernel coverage. # # Die on error. # sub kernel_reset() { local *HANDLE; check_and_load_kernel_module(); info("Resetting kernel execution counters\n"); open(HANDLE, ">$gcov_dir/vmlinux") or die("ERROR: cannot write to $gcov_dir/vmlinux!\n"); print(HANDLE "0"); close(HANDLE); # Unload module if we loaded it in the first place if ($need_unload) { unload_module($need_unload); } } # # kernel_capture() # # Capture kernel coverage data and write it to OUTPUT_FILENAME if specified, # otherwise stdout. # sub kernel_capture() { my @param; check_and_load_kernel_module(); # Make sure the temporary directory is removed upon script termination END { if ($temp_dir_name) { stat($temp_dir_name); if (-r _) { info("Removing temporary directory ". "$temp_dir_name\n"); # Remove temporary directory system("rm", "-rf", $temp_dir_name) and warn("WARNING: cannot remove ". "temporary directory ". "$temp_dir_name!\n"); } } } # Get temporary directory $temp_dir_name = create_temp_dir(); info("Copying kernel data to temporary directory $temp_dir_name\n"); if (!@kernel_directory) { # Copy files from gcov kernel directory system("cp", "-dr", $gcov_dir, $temp_dir_name) and die("ERROR: cannot copy files from $gcov_dir!\n"); } else { # Prefix list of kernel sub-directories with the gcov kernel # directory @kernel_directory = map("$gcov_dir/$_", @kernel_directory); # Copy files from gcov kernel directory system("cp", "-dr", @kernel_directory, $temp_dir_name) and die("ERROR: cannot copy files from ". join(" ", @kernel_directory)."!\n"); } # Make directories writable system("find", $temp_dir_name, "-type", "d", "-exec", "chmod", "u+w", "{}", ";") and die("ERROR: cannot modify access rights for ". "$temp_dir_name!\n"); # Make files writable system("find", $temp_dir_name, "-type", "f", "-exec", "chmod", "u+w", "{}", ";") and die("ERROR: cannot modify access rights for ". "$temp_dir_name!\n"); # Capture data info("Capturing coverage data from $temp_dir_name\n"); @param = ("$tool_dir/geninfo", $temp_dir_name); if ($output_filename) { @param = (@param, "--output-filename", $output_filename); } if ($test_name) { @param = (@param, "--test-name", $test_name); } if ($follow) { @param = (@param, "--follow"); } if ($quiet) { @param = (@param, "--quiet"); } if (defined($checksum)) { if ($checksum) { @param = (@param, "--checksum"); } else { @param = (@param, "--no-checksum"); } } if ($base_directory) { @param = (@param, "--base-directory", $base_directory); } if ($no_compat_libtool) { @param = (@param, "--no-compat-libtool"); } elsif ($compat_libtool) { @param = (@param, "--compat-libtool"); } if ($gcov_tool) { @param = (@param, "--gcov-tool", $gcov_tool); } if ($ignore_errors) { @param = (@param, "--ignore-errors", $ignore_errors); } if ($initial) { @param = (@param, "--initial"); } system(@param) and exit($? >> 8); # Unload module if we loaded it in the first place if ($need_unload) { unload_module($need_unload); } } # # info(printf_parameter) # # Use printf to write PRINTF_PARAMETER to stdout only when the $quiet flag # is not set. # sub info(@) { if (!$quiet) { # Print info string if ($to_file) { print(@_) } else { # Don't interfer with the .info output to STDOUT printf(STDERR @_); } } } # # Check if the gcov kernel module is loaded. If it is, exit, if not, try # to load it. # # Die on error. # sub check_and_load_kernel_module() { my $module_name; # Is it loaded already? stat("$gcov_dir"); if (-r _) { return(); } info("Loading required gcov kernel module.\n"); # Do we have access to the insmod tool? stat($insmod_tool); if (!-x _) { die("ERROR: need insmod tool ($insmod_tool) to access kernel ". "coverage data!\n"); } # Do we have access to the modprobe tool? stat($modprobe_tool); if (!-x _) { die("ERROR: need modprobe tool ($modprobe_tool) to access ". "kernel coverage data!\n"); } # Try some possibilities of where the gcov kernel module may be found foreach $module_name (@gcovmod) { # Try to load module from system wide module directory # /lib/modules if (system_no_output(3, $modprobe_tool, $module_name) == 0) { # Succeeded $need_unload = $module_name; return(); } # Try to load linux 2.5/2.6 module from tool directory if (system_no_output(3, $insmod_tool, "$tool_dir/$module_name.ko") == 0) { # Succeeded $need_unload = $module_name; return(); } # Try to load linux 2.4 module from tool directory if (system_no_output(3, $insmod_tool, "$tool_dir/$module_name.o") == 0) { # Succeeded $need_unload = $module_name; return(); } } # Hm, loading failed - maybe we aren't root? if ($> != 0) { die("ERROR: need root access to load kernel module!\n"); } die("ERROR: cannot load required gcov kernel module!\n"); } # # unload_module() # # Unload the gcov kernel module. # sub unload_module($) { my $module = $_[0]; info("Unloading kernel module $module\n"); # Do we have access to the rmmod tool? stat($rmmod_tool); if (!-x _) { warn("WARNING: cannot execute rmmod tool at $rmmod_tool - ". "gcov module still loaded!\n"); } # Unload gcov kernel module system_no_output(1, $rmmod_tool, $module) and warn("WARNING: cannot unload gcov kernel module ". "$module!\n"); } # # create_temp_dir() # # Create a temporary directory and return its path. # # Die on error. # sub create_temp_dir() { my $dirname; my $number = sprintf("%d", rand(1000)); # Endless loops are evil while ($number++ < 1000) { $dirname = "$tmp_dir/$tmp_prefix$number"; stat($dirname); if (-e _) { next; } mkdir($dirname) or die("ERROR: cannot create temporary directory ". "$dirname!\n"); return($dirname); } die("ERROR: cannot create temporary directory in $tmp_dir!\n"); } # # read_info_file(info_filename) # # Read in the contents of the .info file specified by INFO_FILENAME. Data will # be returned as a reference to a hash containing the following mappings: # # %result: for each filename found in file -> \%data # # %data: "test" -> \%testdata # "sum" -> \%sumcount # "func" -> \%funcdata # "found" -> $lines_found (number of instrumented lines found in file) # "hit" -> $lines_hit (number of executed lines in file) # "check" -> \%checkdata # "testfnc" -> \%testfncdata # "sumfnc" -> \%sumfnccount # # %testdata : name of test affecting this file -> \%testcount # %testfncdata: name of test affecting this file -> \%testfnccount # # %testcount : line number -> execution count for a single test # %testfnccount: function name -> execution count for a single test # %sumcount : line number -> execution count for all tests # %sumfnccount : function name -> execution count for all tests # %funcdata : function name -> line number # %checkdata : line number -> checksum of source code line # # Note that .info file sections referring to the same file and test name # will automatically be combined by adding all execution counts. # # Note that if INFO_FILENAME ends with ".gz", it is assumed that the file # is compressed using GZIP. If available, GUNZIP will be used to decompress # this file. # # Die on error. # sub read_info_file($) { my $tracefile = $_[0]; # Name of tracefile my %result; # Resulting hash: file -> data my $data; # Data handle for current entry my $testdata; # " " my $testcount; # " " my $sumcount; # " " my $funcdata; # " " my $checkdata; # " " my $testfncdata; my $testfnccount; my $sumfnccount; my $line; # Current line read from .info file my $testname; # Current test name my $filename; # Current filename my $hitcount; # Count for lines hit my $count; # Execution count of current line my $negative; # If set, warn about negative counts my $changed_testname; # If set, warn about changed testname my $line_checksum; # Checksum of current line local *INFO_HANDLE; # Filehandle for .info file info("Reading tracefile $tracefile\n"); # Check if file exists and is readable stat($_[0]); if (!(-r _)) { die("ERROR: cannot read file $_[0]!\n"); } # Check if this is really a plain file if (!(-f _)) { die("ERROR: not a plain file: $_[0]!\n"); } # Check for .gz extension if ($_[0] =~ /\.gz$/) { # Check for availability of GZIP tool system_no_output(1, "gunzip" ,"-h") and die("ERROR: gunzip command not available!\n"); # Check integrity of compressed file system_no_output(1, "gunzip", "-t", $_[0]) and die("ERROR: integrity check failed for ". "compressed file $_[0]!\n"); # Open compressed file open(INFO_HANDLE, "gunzip -c $_[0]|") or die("ERROR: cannot start gunzip to decompress ". "file $_[0]!\n"); } else { # Open decompressed file open(INFO_HANDLE, $_[0]) or die("ERROR: cannot read file $_[0]!\n"); } $testname = ""; while () { chomp($_); $line = $_; # Switch statement foreach ($line) { /^TN:([^,]*)/ && do { # Test name information found $testname = defined($1) ? $1 : ""; if ($testname =~ s/\W/_/g) { $changed_testname = 1; } last; }; /^[SK]F:(.*)/ && do { # Filename information found # Retrieve data for new entry $filename = $1; $data = $result{$filename}; ($testdata, $sumcount, $funcdata, $checkdata, $testfncdata, $sumfnccount) = get_info_entry($data); if (defined($testname)) { $testcount = $testdata->{$testname}; $testfnccount = $testfncdata->{$testname}; } else { $testcount = {}; $testfnccount = {}; } last; }; /^DA:(\d+),(-?\d+)(,[^,\s]+)?/ && do { # Fix negative counts $count = $2 < 0 ? 0 : $2; if ($2 < 0) { $negative = 1; } # Execution count found, add to structure # Add summary counts $sumcount->{$1} += $count; # Add test-specific counts if (defined($testname)) { $testcount->{$1} += $count; } # Store line checksum if available if (defined($3)) { $line_checksum = substr($3, 1); # Does it match a previous definition if (defined($checkdata->{$1}) && ($checkdata->{$1} ne $line_checksum)) { die("ERROR: checksum mismatch ". "at $filename:$1\n"); } $checkdata->{$1} = $line_checksum; } last; }; /^FN:(\d+),([^,]+)/ && do { # Function data found, add to structure $funcdata->{$2} = $1; # Also initialize function call data if (!defined($sumfnccount->{$2})) { $sumfnccount->{$2} = 0; } if (defined($testname)) { if (!defined($testfnccount->{$2})) { $testfnccount->{$2} = 0; } } last; }; /^FNDA:(\d+),([^,]+)/ && do { # Function call count found, add to structure # Add summary counts $sumfnccount->{$2} += $1; # Add test-specific counts if (defined($testname)) { $testfnccount->{$2} += $1; } last; }; /^end_of_record/ && do { # Found end of section marker if ($filename) { # Store current section data if (defined($testname)) { $testdata->{$testname} = $testcount; $testfncdata->{$testname} = $testfnccount; } set_info_entry($data, $testdata, $sumcount, $funcdata, $checkdata, $testfncdata, $sumfnccount); $result{$filename} = $data; last; } }; # default last; } } close(INFO_HANDLE); # Calculate hit and found values for lines and functions of each file foreach $filename (keys(%result)) { $data = $result{$filename}; ($testdata, $sumcount, undef, undef, $testfncdata, $sumfnccount) = get_info_entry($data); # Filter out empty files if (scalar(keys(%{$sumcount})) == 0) { delete($result{$filename}); next; } # Filter out empty test cases foreach $testname (keys(%{$testdata})) { if (!defined($testdata->{$testname}) || scalar(keys(%{$testdata->{$testname}})) == 0) { delete($testdata->{$testname}); delete($testfncdata->{$testname}); } } $data->{"found"} = scalar(keys(%{$sumcount})); $hitcount = 0; foreach (keys(%{$sumcount})) { if ($sumcount->{$_} > 0) { $hitcount++; } } $data->{"hit"} = $hitcount; # Get found/hit values for function call data $data->{"f_found"} = scalar(keys(%{$sumfnccount})); $hitcount = 0; foreach (keys(%{$sumfnccount})) { if ($sumfnccount->{$_} > 0) { $hitcount++; } } $data->{"f_hit"} = $hitcount; } if (scalar(keys(%result)) == 0) { die("ERROR: no valid records found in tracefile $tracefile\n"); } if ($negative) { warn("WARNING: negative counts found in tracefile ". "$tracefile\n"); } if ($changed_testname) { warn("WARNING: invalid characters removed from testname in ". "tracefile $tracefile\n"); } return(\%result); } # # get_info_entry(hash_ref) # # Retrieve data from an entry of the structure generated by read_info_file(). # Return a list of references to hashes: # (test data hash ref, sum count hash ref, funcdata hash ref, checkdata hash # ref, testfncdata hash ref, sumfnccount hash ref, lines found, lines hit, # functions found, functions hit) # sub get_info_entry($) { my $testdata_ref = $_[0]->{"test"}; my $sumcount_ref = $_[0]->{"sum"}; my $funcdata_ref = $_[0]->{"func"}; my $checkdata_ref = $_[0]->{"check"}; my $testfncdata = $_[0]->{"testfnc"}; my $sumfnccount = $_[0]->{"sumfnc"}; my $lines_found = $_[0]->{"found"}; my $lines_hit = $_[0]->{"hit"}; my $f_found = $_[0]->{"f_found"}; my $f_hit = $_[0]->{"f_hit"}; return ($testdata_ref, $sumcount_ref, $funcdata_ref, $checkdata_ref, $testfncdata, $sumfnccount, $lines_found, $lines_hit, $f_found, $f_hit); } # # set_info_entry(hash_ref, testdata_ref, sumcount_ref, funcdata_ref, # checkdata_ref, testfncdata_ref, sumfcncount_ref[,lines_found, # lines_hit, f_found, f_hit]) # # Update the hash referenced by HASH_REF with the provided data references. # sub set_info_entry($$$$$$$;$$$$) { my $data_ref = $_[0]; $data_ref->{"test"} = $_[1]; $data_ref->{"sum"} = $_[2]; $data_ref->{"func"} = $_[3]; $data_ref->{"check"} = $_[4]; $data_ref->{"testfnc"} = $_[5]; $data_ref->{"sumfnc"} = $_[6]; if (defined($_[7])) { $data_ref->{"found"} = $_[7]; } if (defined($_[8])) { $data_ref->{"hit"} = $_[8]; } if (defined($_[9])) { $data_ref->{"f_found"} = $_[9]; } if (defined($_[10])) { $data_ref->{"f_hit"} = $_[10]; } } # # add_counts(data1_ref, data2_ref) # # DATA1_REF and DATA2_REF are references to hashes containing a mapping # # line number -> execution count # # Return a list (RESULT_REF, LINES_FOUND, LINES_HIT) where RESULT_REF # is a reference to a hash containing the combined mapping in which # execution counts are added. # sub add_counts($$) { my %data1 = %{$_[0]}; # Hash 1 my %data2 = %{$_[1]}; # Hash 2 my %result; # Resulting hash my $line; # Current line iteration scalar my $data1_count; # Count of line in hash1 my $data2_count; # Count of line in hash2 my $found = 0; # Total number of lines found my $hit = 0; # Number of lines with a count > 0 foreach $line (keys(%data1)) { $data1_count = $data1{$line}; $data2_count = $data2{$line}; # Add counts if present in both hashes if (defined($data2_count)) { $data1_count += $data2_count; } # Store sum in %result $result{$line} = $data1_count; $found++; if ($data1_count > 0) { $hit++; } } # Add lines unique to data2 foreach $line (keys(%data2)) { # Skip lines already in data1 if (defined($data1{$line})) { next; } # Copy count from data2 $result{$line} = $data2{$line}; $found++; if ($result{$line} > 0) { $hit++; } } return (\%result, $found, $hit); } # # merge_checksums(ref1, ref2, filename) # # REF1 and REF2 are references to hashes containing a mapping # # line number -> checksum # # Merge checksum lists defined in REF1 and REF2 and return reference to # resulting hash. Die if a checksum for a line is defined in both hashes # but does not match. # sub merge_checksums($$$) { my $ref1 = $_[0]; my $ref2 = $_[1]; my $filename = $_[2]; my %result; my $line; foreach $line (keys(%{$ref1})) { if (defined($ref2->{$line}) && ($ref1->{$line} ne $ref2->{$line})) { die("ERROR: checksum mismatch at $filename:$line\n"); } $result{$line} = $ref1->{$line}; } foreach $line (keys(%{$ref2})) { $result{$line} = $ref2->{$line}; } return \%result; } # # merge_func_data(funcdata1, funcdata2, filename) # sub merge_func_data($$$) { my ($funcdata1, $funcdata2, $filename) = @_; my %result; my $func; %result = %{$funcdata1}; foreach $func (keys(%{$funcdata2})) { my $line1 = $result{$func}; my $line2 = $funcdata2->{$func}; if (defined($line1) && ($line1 != $line2)) { warn("WARNING: function data mismatch at ". "$filename:$line2\n"); next; } $result{$func} = $line2; } return \%result; } # # add_fnccount(fnccount1, fnccount2) # # Add function call count data. Return list (fnccount_added, f_found, f_hit) # sub add_fnccount($$) { my ($fnccount1, $fnccount2) = @_; my %result; my $f_found; my $f_hit; my $function; %result = %{$fnccount1}; foreach $function (keys(%{$fnccount2})) { $result{$function} += $fnccount2->{$function}; } $f_found = scalar(keys(%result)); $f_hit = 0; foreach $function (keys(%result)) { if ($result{$function} > 0) { $f_hit++; } } return (\%result, $f_found, $f_hit); } # # add_testfncdata(testfncdata1, testfncdata2) # # Add function call count data for several tests. Return reference to # added_testfncdata. # sub add_testfncdata($$) { my ($testfncdata1, $testfncdata2) = @_; my %result; my $testname; foreach $testname (keys(%{$testfncdata1})) { if (defined($testfncdata2->{$testname})) { my $fnccount; # Function call count data for this testname exists # in both data sets: merge ($fnccount) = add_fnccount( $testfncdata1->{$testname}, $testfncdata2->{$testname}); $result{$testname} = $fnccount; next; } # Function call count data for this testname is unique to # data set 1: copy $result{$testname} = $testfncdata1->{$testname}; } # Add count data for testnames unique to data set 2 foreach $testname (keys(%{$testfncdata2})) { if (!defined($result{$testname})) { $result{$testname} = $testfncdata2->{$testname}; } } return \%result; } # # combine_info_entries(entry_ref1, entry_ref2, filename) # # Combine .info data entry hashes referenced by ENTRY_REF1 and ENTRY_REF2. # Return reference to resulting hash. # sub combine_info_entries($$$) { my $entry1 = $_[0]; # Reference to hash containing first entry my $testdata1; my $sumcount1; my $funcdata1; my $checkdata1; my $testfncdata1; my $sumfnccount1; my $entry2 = $_[1]; # Reference to hash containing second entry my $testdata2; my $sumcount2; my $funcdata2; my $checkdata2; my $testfncdata2; my $sumfnccount2; my %result; # Hash containing combined entry my %result_testdata; my $result_sumcount = {}; my $result_funcdata; my $result_testfncdata; my $result_sumfnccount; my $lines_found; my $lines_hit; my $f_found; my $f_hit; my $testname; my $filename = $_[2]; # Retrieve data ($testdata1, $sumcount1, $funcdata1, $checkdata1, $testfncdata1, $sumfnccount1) = get_info_entry($entry1); ($testdata2, $sumcount2, $funcdata2, $checkdata2, $testfncdata2, $sumfnccount2) = get_info_entry($entry2); # Merge checksums $checkdata1 = merge_checksums($checkdata1, $checkdata2, $filename); # Combine funcdata $result_funcdata = merge_func_data($funcdata1, $funcdata2, $filename); # Combine function call count data $result_testfncdata = add_testfncdata($testfncdata1, $testfncdata2); ($result_sumfnccount, $f_found, $f_hit) = add_fnccount($sumfnccount1, $sumfnccount2); # Combine testdata foreach $testname (keys(%{$testdata1})) { if (defined($testdata2->{$testname})) { # testname is present in both entries, requires # combination ($result_testdata{$testname}) = add_counts($testdata1->{$testname}, $testdata2->{$testname}); } else { # testname only present in entry1, add to result $result_testdata{$testname} = $testdata1->{$testname}; } # update sum count hash ($result_sumcount, $lines_found, $lines_hit) = add_counts($result_sumcount, $result_testdata{$testname}); } foreach $testname (keys(%{$testdata2})) { # Skip testnames already covered by previous iteration if (defined($testdata1->{$testname})) { next; } # testname only present in entry2, add to result hash $result_testdata{$testname} = $testdata2->{$testname}; # update sum count hash ($result_sumcount, $lines_found, $lines_hit) = add_counts($result_sumcount, $result_testdata{$testname}); } # Calculate resulting sumcount # Store result set_info_entry(\%result, \%result_testdata, $result_sumcount, $result_funcdata, $checkdata1, $result_testfncdata, $result_sumfnccount, $lines_found, $lines_hit, $f_found, $f_hit); return(\%result); } # # combine_info_files(info_ref1, info_ref2) # # Combine .info data in hashes referenced by INFO_REF1 and INFO_REF2. Return # reference to resulting hash. # sub combine_info_files($$) { my %hash1 = %{$_[0]}; my %hash2 = %{$_[1]}; my $filename; foreach $filename (keys(%hash2)) { if ($hash1{$filename}) { # Entry already exists in hash1, combine them $hash1{$filename} = combine_info_entries($hash1{$filename}, $hash2{$filename}, $filename); } else { # Entry is unique in both hashes, simply add to # resulting hash $hash1{$filename} = $hash2{$filename}; } } return(\%hash1); } # # add_traces() # sub add_traces() { my $total_trace; my $current_trace; my $tracefile; local *INFO_HANDLE; info("Combining tracefiles.\n"); foreach $tracefile (@add_tracefile) { $current_trace = read_info_file($tracefile); if ($total_trace) { $total_trace = combine_info_files($total_trace, $current_trace); } else { $total_trace = $current_trace; } } # Write combined data if ($to_file) { info("Writing data to $output_filename\n"); open(INFO_HANDLE, ">$output_filename") or die("ERROR: cannot write to $output_filename!\n"); write_info_file(*INFO_HANDLE, $total_trace); close(*INFO_HANDLE); } else { write_info_file(*STDOUT, $total_trace); } } # # write_info_file(filehandle, data) # sub write_info_file(*$) { local *INFO_HANDLE = $_[0]; my %data = %{$_[1]}; my $source_file; my $entry; my $testdata; my $sumcount; my $funcdata; my $checkdata; my $testfncdata; my $sumfnccount; my $testname; my $line; my $func; my $testcount; my $testfnccount; my $found; my $hit; my $f_found; my $f_hit; foreach $source_file (keys(%data)) { $entry = $data{$source_file}; ($testdata, $sumcount, $funcdata, $checkdata, $testfncdata, $sumfnccount) = get_info_entry($entry); foreach $testname (keys(%{$testdata})) { $testcount = $testdata->{$testname}; $testfnccount = $testfncdata->{$testname}; $found = 0; $hit = 0; print(INFO_HANDLE "TN:$testname\n"); print(INFO_HANDLE "SF:$source_file\n"); # Write function related data foreach $func ( sort({$funcdata->{$a} <=> $funcdata->{$b}} keys(%{$funcdata}))) { print(INFO_HANDLE "FN:".$funcdata->{$func}. ",$func\n"); } foreach $func (keys(%{$testfnccount})) { print(INFO_HANDLE "FNDA:". $testfnccount->{$func}. ",$func\n"); } ($f_found, $f_hit) = get_func_found_and_hit($testfnccount); print(INFO_HANDLE "FNF:$f_found\n"); print(INFO_HANDLE "FNH:$f_hit\n"); # Write line related data foreach $line (sort({$a <=> $b} keys(%{$testcount}))) { print(INFO_HANDLE "DA:$line,". $testcount->{$line}. (defined($checkdata->{$line}) && $checksum ? ",".$checkdata->{$line} : "")."\n"); $found++; if ($testcount->{$line} > 0) { $hit++; } } print(INFO_HANDLE "LF:$found\n"); print(INFO_HANDLE "LH:$hit\n"); print(INFO_HANDLE "end_of_record\n"); } } } # # transform_pattern(pattern) # # Transform shell wildcard expression to equivalent PERL regular expression. # Return transformed pattern. # sub transform_pattern($) { my $pattern = $_[0]; # Escape special chars $pattern =~ s/\\/\\\\/g; $pattern =~ s/\//\\\//g; $pattern =~ s/\^/\\\^/g; $pattern =~ s/\$/\\\$/g; $pattern =~ s/\(/\\\(/g; $pattern =~ s/\)/\\\)/g; $pattern =~ s/\[/\\\[/g; $pattern =~ s/\]/\\\]/g; $pattern =~ s/\{/\\\{/g; $pattern =~ s/\}/\\\}/g; $pattern =~ s/\./\\\./g; $pattern =~ s/\,/\\\,/g; $pattern =~ s/\|/\\\|/g; $pattern =~ s/\+/\\\+/g; $pattern =~ s/\!/\\\!/g; # Transform ? => (.) and * => (.*) $pattern =~ s/\*/\(\.\*\)/g; $pattern =~ s/\?/\(\.\)/g; return $pattern; } # # extract() # sub extract() { my $data = read_info_file($extract); my $filename; my $keep; my $pattern; my @pattern_list; my $extracted = 0; local *INFO_HANDLE; # Need perlreg expressions instead of shell pattern @pattern_list = map({ transform_pattern($_); } @ARGV); # Filter out files which do not match any pattern foreach $filename (sort(keys(%{$data}))) { $keep = 0; foreach $pattern (@pattern_list) { $keep ||= ($filename =~ (/^$pattern$/)); } if (!$keep) { delete($data->{$filename}); } else { info("Extracting $filename\n"), $extracted++; } } # Write extracted data if ($to_file) { info("Extracted $extracted files\n"); info("Writing data to $output_filename\n"); open(INFO_HANDLE, ">$output_filename") or die("ERROR: cannot write to $output_filename!\n"); write_info_file(*INFO_HANDLE, $data); close(*INFO_HANDLE); } else { write_info_file(*STDOUT, $data); } } # # remove() # sub remove() { my $data = read_info_file($remove); my $filename; my $match_found; my $pattern; my @pattern_list; my $removed = 0; local *INFO_HANDLE; # Need perlreg expressions instead of shell pattern @pattern_list = map({ transform_pattern($_); } @ARGV); # Filter out files that match the pattern foreach $filename (sort(keys(%{$data}))) { $match_found = 0; foreach $pattern (@pattern_list) { $match_found ||= ($filename =~ (/$pattern$/)); } if ($match_found) { delete($data->{$filename}); info("Removing $filename\n"), $removed++; } } # Write data if ($to_file) { info("Deleted $removed files\n"); info("Writing data to $output_filename\n"); open(INFO_HANDLE, ">$output_filename") or die("ERROR: cannot write to $output_filename!\n"); write_info_file(*INFO_HANDLE, $data); close(*INFO_HANDLE); } else { write_info_file(*STDOUT, $data); } } # # list() # sub list() { my $data = read_info_file($list); my $filename; my $found; my $hit; my $entry; info("Listing contents of $list:\n"); # List all files foreach $filename (sort(keys(%{$data}))) { $entry = $data->{$filename}; (undef, undef, undef, undef, undef, undef, $found, $hit) = get_info_entry($entry); printf("$filename: $hit of $found lines hit\n"); } } # # get_common_filename(filename1, filename2) # # Check for filename components which are common to FILENAME1 and FILENAME2. # Upon success, return # # (common, path1, path2) # # or 'undef' in case there are no such parts. # sub get_common_filename($$) { my @list1 = split("/", $_[0]); my @list2 = split("/", $_[1]); my @result; # Work in reverse order, i.e. beginning with the filename itself while (@list1 && @list2 && ($list1[$#list1] eq $list2[$#list2])) { unshift(@result, pop(@list1)); pop(@list2); } # Did we find any similarities? if (scalar(@result) > 0) { return (join("/", @result), join("/", @list1), join("/", @list2)); } else { return undef; } } # # strip_directories($path, $depth) # # Remove DEPTH leading directory levels from PATH. # sub strip_directories($$) { my $filename = $_[0]; my $depth = $_[1]; my $i; if (!defined($depth) || ($depth < 1)) { return $filename; } for ($i = 0; $i < $depth; $i++) { $filename =~ s/^[^\/]*\/+(.*)$/$1/; } return $filename; } # # read_diff(filename) # # Read diff output from FILENAME to memory. The diff file has to follow the # format generated by 'diff -u'. Returns a list of hash references: # # (mapping, path mapping) # # mapping: filename -> reference to line hash # line hash: line number in new file -> corresponding line number in old file # # path mapping: filename -> old filename # # Die in case of error. # sub read_diff($) { my $diff_file = $_[0]; # Name of diff file my %diff; # Resulting mapping filename -> line hash my %paths; # Resulting mapping old path -> new path my $mapping; # Reference to current line hash my $line; # Contents of current line my $num_old; # Current line number in old file my $num_new; # Current line number in new file my $file_old; # Name of old file in diff section my $file_new; # Name of new file in diff section my $filename; # Name of common filename of diff section my $in_block = 0; # Non-zero while we are inside a diff block local *HANDLE; # File handle for reading the diff file info("Reading diff $diff_file\n"); # Check if file exists and is readable stat($diff_file); if (!(-r _)) { die("ERROR: cannot read file $diff_file!\n"); } # Check if this is really a plain file if (!(-f _)) { die("ERROR: not a plain file: $diff_file!\n"); } # Check for .gz extension if ($diff_file =~ /\.gz$/) { # Check for availability of GZIP tool system_no_output(1, "gunzip", "-h") and die("ERROR: gunzip command not available!\n"); # Check integrity of compressed file system_no_output(1, "gunzip", "-t", $diff_file) and die("ERROR: integrity check failed for ". "compressed file $diff_file!\n"); # Open compressed file open(HANDLE, "gunzip -c $diff_file|") or die("ERROR: cannot start gunzip to decompress ". "file $_[0]!\n"); } else { # Open decompressed file open(HANDLE, $diff_file) or die("ERROR: cannot read file $_[0]!\n"); } # Parse diff file line by line while () { chomp($_); $line = $_; foreach ($line) { # Filename of old file: # --- /^--- (\S+)/ && do { $file_old = strip_directories($1, $strip); last; }; # Filename of new file: # +++ /^\+\+\+ (\S+)/ && do { # Add last file to resulting hash if ($filename) { my %new_hash; $diff{$filename} = $mapping; $mapping = \%new_hash; } $file_new = strip_directories($1, $strip); $filename = $file_old; $paths{$filename} = $file_new; $num_old = 1; $num_new = 1; last; }; # Start of diff block: # @@ -old_start,old_num, +new_start,new_num @@ /^\@\@\s+-(\d+),(\d+)\s+\+(\d+),(\d+)\s+\@\@$/ && do { $in_block = 1; while ($num_old < $1) { $mapping->{$num_new} = $num_old; $num_old++; $num_new++; } last; }; # Unchanged line # /^ / && do { if ($in_block == 0) { last; } $mapping->{$num_new} = $num_old; $num_old++; $num_new++; last; }; # Line as seen in old file # /^-/ && do { if ($in_block == 0) { last; } $num_old++; last; }; # Line as seen in new file # /^\+/ && do { if ($in_block == 0) { last; } $num_new++; last; }; # Empty line /^$/ && do { if ($in_block == 0) { last; } $mapping->{$num_new} = $num_old; $num_old++; $num_new++; last; }; } } close(HANDLE); # Add final diff file section to resulting hash if ($filename) { $diff{$filename} = $mapping; } if (!%diff) { die("ERROR: no valid diff data found in $diff_file!\n". "Make sure to use 'diff -u' when generating the diff ". "file.\n"); } return (\%diff, \%paths); } # # apply_diff($count_data, $line_hash) # # Transform count data using a mapping of lines: # # $count_data: reference to hash: line number -> data # $line_hash: reference to hash: line number new -> line number old # # Return a reference to transformed count data. # sub apply_diff($$) { my $count_data = $_[0]; # Reference to data hash: line -> hash my $line_hash = $_[1]; # Reference to line hash: new line -> old line my %result; # Resulting hash my $last_new = 0; # Last new line number found in line hash my $last_old = 0; # Last old line number found in line hash # Iterate all new line numbers found in the diff foreach (sort({$a <=> $b} keys(%{$line_hash}))) { $last_new = $_; $last_old = $line_hash->{$last_new}; # Is there data associated with the corresponding old line? if (defined($count_data->{$line_hash->{$_}})) { # Copy data to new hash with a new line number $result{$_} = $count_data->{$line_hash->{$_}}; } } # Transform all other lines which come after the last diff entry foreach (sort({$a <=> $b} keys(%{$count_data}))) { if ($_ <= $last_old) { # Skip lines which were covered by line hash next; } # Copy data to new hash with an offset $result{$_ + ($last_new - $last_old)} = $count_data->{$_}; } return \%result; } # # get_hash_max(hash_ref) # # Return the highest integer key from hash. # sub get_hash_max($) { my ($hash) = @_; my $max; foreach (keys(%{$hash})) { if (!defined($max)) { $max = $_; } elsif ($hash->{$_} > $max) { $max = $_; } } return $max; } sub get_hash_reverse($) { my ($hash) = @_; my %result; foreach (keys(%{$hash})) { $result{$hash->{$_}} = $_; } return \%result; } # # apply_diff_to_funcdata(funcdata, line_hash) # sub apply_diff_to_funcdata($$) { my ($funcdata, $linedata) = @_; my $last_new = get_hash_max($linedata); my $last_old = $linedata->{$last_new}; my $func; my %result; my $line_diff = get_hash_reverse($linedata); foreach $func (keys(%{$funcdata})) { my $line = $funcdata->{$func}; if (defined($line_diff->{$line})) { $result{$func} = $line_diff->{$line}; } elsif ($line > $last_old) { $result{$func} = $line + $last_new - $last_old; } } return \%result; } # # get_line_hash($filename, $diff_data, $path_data) # # Find line hash in DIFF_DATA which matches FILENAME. On success, return list # line hash. or undef in case of no match. Die if more than one line hashes in # DIFF_DATA match. # sub get_line_hash($$$) { my $filename = $_[0]; my $diff_data = $_[1]; my $path_data = $_[2]; my $conversion; my $old_path; my $new_path; my $diff_name; my $common; my $old_depth; my $new_depth; foreach (keys(%{$diff_data})) { # Try to match diff filename with filename if ($filename =~ /^\Q$diff_path\E\/$_$/) { if ($diff_name) { # Two files match, choose the more specific one # (the one with more path components) $old_depth = ($diff_name =~ tr/\///); $new_depth = (tr/\///); if ($old_depth == $new_depth) { die("ERROR: diff file contains ". "ambiguous entries for ". "$filename\n"); } elsif ($new_depth > $old_depth) { $diff_name = $_; } } else { $diff_name = $_; } }; } if ($diff_name) { # Get converted path if ($filename =~ /^(.*)$diff_name$/) { ($common, $old_path, $new_path) = get_common_filename($filename, $1.$path_data->{$diff_name}); } return ($diff_data->{$diff_name}, $old_path, $new_path); } else { return undef; } } # # convert_paths(trace_data, path_conversion_data) # # Rename all paths in TRACE_DATA which show up in PATH_CONVERSION_DATA. # sub convert_paths($$) { my $trace_data = $_[0]; my $path_conversion_data = $_[1]; my $filename; my $new_path; if (scalar(keys(%{$path_conversion_data})) == 0) { info("No path conversion data available.\n"); return; } # Expand path conversion list foreach $filename (keys(%{$path_conversion_data})) { $new_path = $path_conversion_data->{$filename}; while (($filename =~ s/^(.*)\/[^\/]+$/$1/) && ($new_path =~ s/^(.*)\/[^\/]+$/$1/) && ($filename ne $new_path)) { $path_conversion_data->{$filename} = $new_path; } } # Adjust paths FILENAME: foreach $filename (keys(%{$trace_data})) { # Find a path in our conversion table that matches, starting # with the longest path foreach (sort({length($b) <=> length($a)} keys(%{$path_conversion_data}))) { # Is this path a prefix of our filename? if (!($filename =~ /^$_(.*)$/)) { next; } $new_path = $path_conversion_data->{$_}.$1; # Make sure not to overwrite an existing entry under # that path name if ($trace_data->{$new_path}) { # Need to combine entries $trace_data->{$new_path} = combine_info_entries( $trace_data->{$filename}, $trace_data->{$new_path}, $filename); } else { # Simply rename entry $trace_data->{$new_path} = $trace_data->{$filename}; } delete($trace_data->{$filename}); next FILENAME; } info("No conversion available for filename $filename\n"); } } # # sub adjust_fncdata(funcdata, testfncdata, sumfnccount) # # Remove function call count data from testfncdata and sumfnccount which # is no longer present in funcdata. # sub adjust_fncdata($$$) { my ($funcdata, $testfncdata, $sumfnccount) = @_; my $testname; my $func; my $f_found; my $f_hit; # Remove count data in testfncdata for functions which are no longer # in funcdata foreach $testname (%{$testfncdata}) { my $fnccount = $testfncdata->{$testname}; foreach $func (%{$fnccount}) { if (!defined($funcdata->{$func})) { delete($fnccount->{$func}); } } } # Remove count data in sumfnccount for functions which are no longer # in funcdata foreach $func (%{$sumfnccount}) { if (!defined($funcdata->{$func})) { delete($sumfnccount->{$func}); } } } # # get_func_found_and_hit(sumfnccount) # # Return (f_found, f_hit) for sumfnccount # sub get_func_found_and_hit($) { my ($sumfnccount) = @_; my $function; my $f_found; my $f_hit; $f_found = scalar(keys(%{$sumfnccount})); $f_hit = 0; foreach $function (keys(%{$sumfnccount})) { if ($sumfnccount->{$function} > 0) { $f_hit++; } } return ($f_found, $f_hit); } # # diff() # sub diff() { my $trace_data = read_info_file($diff); my $diff_data; my $path_data; my $old_path; my $new_path; my %path_conversion_data; my $filename; my $line_hash; my $new_name; my $entry; my $testdata; my $testname; my $sumcount; my $funcdata; my $checkdata; my $testfncdata; my $sumfnccount; my $found; my $hit; my $f_found; my $f_hit; my $converted = 0; my $unchanged = 0; local *INFO_HANDLE; ($diff_data, $path_data) = read_diff($ARGV[0]); foreach $filename (sort(keys(%{$trace_data}))) { # Find a diff section corresponding to this file ($line_hash, $old_path, $new_path) = get_line_hash($filename, $diff_data, $path_data); if (!$line_hash) { # There's no diff section for this file $unchanged++; next; } $converted++; if ($old_path && $new_path && ($old_path ne $new_path)) { $path_conversion_data{$old_path} = $new_path; } # Check for deleted files if (scalar(keys(%{$line_hash})) == 0) { info("Removing $filename\n"); delete($trace_data->{$filename}); next; } info("Converting $filename\n"); $entry = $trace_data->{$filename}; ($testdata, $sumcount, $funcdata, $checkdata, $testfncdata, $sumfnccount) = get_info_entry($entry); # Convert test data foreach $testname (keys(%{$testdata})) { $testdata->{$testname} = apply_diff($testdata->{$testname}, $line_hash); # Remove empty sets of test data if (scalar(keys(%{$testdata->{$testname}})) == 0) { delete($testdata->{$testname}); delete($testfncdata->{$testname}); } } # Rename test data to indicate conversion foreach $testname (keys(%{$testdata})) { # Skip testnames which already contain an extension if ($testname =~ /,[^,]+$/) { next; } # Check for name conflict if (defined($testdata->{$testname.",diff"})) { # Add counts ($testdata->{$testname}) = add_counts( $testdata->{$testname}, $testdata->{$testname.",diff"}); delete($testdata->{$testname.",diff"}); # Add function call counts ($testfncdata->{$testname}) = add_fnccount( $testfncdata->{$testname}, $testfncdata->{$testname.",diff"}); delete($testfncdata->{$testname.",diff"}); } # Move test data to new testname $testdata->{$testname.",diff"} = $testdata->{$testname}; delete($testdata->{$testname}); # Move function call count data to new testname $testfncdata->{$testname.",diff"} = $testfncdata->{$testname}; delete($testfncdata->{$testname}); } # Convert summary of test data $sumcount = apply_diff($sumcount, $line_hash); # Convert function data $funcdata = apply_diff_to_funcdata($funcdata, $line_hash); # Convert checksum data $checkdata = apply_diff($checkdata, $line_hash); # Convert function call count data adjust_fncdata($funcdata, $testfncdata, $sumfnccount); ($f_found, $f_hit) = get_func_found_and_hit($sumfnccount); # Update found/hit numbers $found = 0; $hit = 0; foreach (keys(%{$sumcount})) { $found++; if ($sumcount->{$_} > 0) { $hit++; } } if ($found > 0) { # Store converted entry set_info_entry($entry, $testdata, $sumcount, $funcdata, $checkdata, $testfncdata, $sumfnccount, $found, $hit, $f_found, $f_hit); } else { # Remove empty data set delete($trace_data->{$filename}); } } # Convert filenames as well if requested if ($convert_filenames) { convert_paths($trace_data, \%path_conversion_data); } info("$converted entr".($converted != 1 ? "ies" : "y")." converted, ". "$unchanged entr".($unchanged != 1 ? "ies" : "y")." left ". "unchanged.\n"); # Write data if ($to_file) { info("Writing data to $output_filename\n"); open(INFO_HANDLE, ">$output_filename") or die("ERROR: cannot write to $output_filename!\n"); write_info_file(*INFO_HANDLE, $trace_data); close(*INFO_HANDLE); } else { write_info_file(*STDOUT, $trace_data); } } # # system_no_output(mode, parameters) # # Call an external program using PARAMETERS while suppressing depending on # the value of MODE: # # MODE & 1: suppress STDOUT # MODE & 2: suppress STDERR # # Return 0 on success, non-zero otherwise. # sub system_no_output($@) { my $mode = shift; my $result; local *OLD_STDERR; local *OLD_STDOUT; # Save old stdout and stderr handles ($mode & 1) && open(OLD_STDOUT, ">>&STDOUT"); ($mode & 2) && open(OLD_STDERR, ">>&STDERR"); # Redirect to /dev/null ($mode & 1) && open(STDOUT, ">/dev/null"); ($mode & 2) && open(STDERR, ">/dev/null"); system(@_); $result = $?; # Close redirected handles ($mode & 1) && close(STDOUT); ($mode & 2) && close(STDERR); # Restore old handles ($mode & 1) && open(STDOUT, ">>&OLD_STDOUT"); ($mode & 2) && open(STDERR, ">>&OLD_STDERR"); return $result; } # # read_config(filename) # # Read configuration file FILENAME and return a reference to a hash containing # all valid key=value pairs found. # sub read_config($) { my $filename = $_[0]; my %result; my $key; my $value; local *HANDLE; if (!open(HANDLE, "<$filename")) { warn("WARNING: cannot read configuration file $filename\n"); return undef; } while () { chomp; # Skip comments s/#.*//; # Remove leading blanks s/^\s+//; # Remove trailing blanks s/\s+$//; next unless length; ($key, $value) = split(/\s*=\s*/, $_, 2); if (defined($key) && defined($value)) { $result{$key} = $value; } else { warn("WARNING: malformed statement in line $. ". "of configuration file $filename\n"); } } close(HANDLE); return \%result; } # # apply_config(REF) # # REF is a reference to a hash containing the following mapping: # # key_string => var_ref # # where KEY_STRING is a keyword and VAR_REF is a reference to an associated # variable. If the global configuration hash CONFIG contains a value for # keyword KEY_STRING, VAR_REF will be assigned the value for that keyword. # sub apply_config($) { my $ref = $_[0]; foreach (keys(%{$ref})) { if (defined($config->{$_})) { ${$ref->{$_}} = $config->{$_}; } } } sub warn_handler($) { my ($msg) = @_; warn("$tool_name: $msg"); } sub die_handler($) { my ($msg) = @_; die("$tool_name: $msg"); }