1#!/usr/bin/perl -w 2# 3# Copyright (c) International Business Machines Corp., 2002,2007 4# 5# This program is free software; you can redistribute it and/or modify 6# it under the terms of the GNU General Public License as published by 7# the Free Software Foundation; either version 2 of the License, or (at 8# your option) any later version. 9# 10# This program is distributed in the hope that it will be useful, but 11# WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13# General Public License for more details. 14# 15# You should have received a copy of the GNU General Public License 16# along with this program; if not, write to the Free Software 17# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18# 19# 20# geninfo 21# 22# This script generates .info files from data files as created by code 23# instrumented with gcc's built-in profiling mechanism. Call it with 24# --help and refer to the geninfo man page to get information on usage 25# and available options. 26# 27# 28# Authors: 29# 2002-08-23 created by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com> 30# IBM Lab Boeblingen 31# based on code by Manoj Iyer <manjo@mail.utexas.edu> and 32# Megan Bock <mbock@us.ibm.com> 33# IBM Austin 34# 2002-09-05 / Peter Oberparleiter: implemented option that allows file list 35# 2003-04-16 / Peter Oberparleiter: modified read_gcov so that it can also 36# parse the new gcov format which is to be introduced in gcc 3.3 37# 2003-04-30 / Peter Oberparleiter: made info write to STDERR, not STDOUT 38# 2003-07-03 / Peter Oberparleiter: added line checksum support, added 39# --no-checksum 40# 2003-09-18 / Nigel Hinds: capture branch coverage data from GCOV 41# 2003-12-11 / Laurent Deniel: added --follow option 42# workaround gcov (<= 3.2.x) bug with empty .da files 43# 2004-01-03 / Laurent Deniel: Ignore empty .bb files 44# 2004-02-16 / Andreas Krebbel: Added support for .gcno/.gcda files and 45# gcov versioning 46# 2004-08-09 / Peter Oberparleiter: added configuration file support 47# 2008-07-14 / Tom Zoerner: added --function-coverage command line option 48# 2008-08-13 / Peter Oberparleiter: modified function coverage 49# implementation (now enabled per default) 50# 51 52use strict; 53use File::Basename; 54use Getopt::Long; 55use Digest::MD5 qw(md5_base64); 56 57 58# Constants 59our $lcov_version = "LCOV version 1.7"; 60our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php"; 61our $gcov_tool = "gcov"; 62our $tool_name = basename($0); 63 64our $GCOV_VERSION_3_4_0 = 0x30400; 65our $GCOV_VERSION_3_3_0 = 0x30300; 66our $GCNO_FUNCTION_TAG = 0x01000000; 67our $GCNO_LINES_TAG = 0x01450000; 68our $GCNO_FILE_MAGIC = 0x67636e6f; 69our $BBG_FILE_MAGIC = 0x67626267; 70 71our $COMPAT_HAMMER = "hammer"; 72 73our $ERROR_GCOV = 0; 74our $ERROR_SOURCE = 1; 75 76# Prototypes 77sub print_usage(*); 78sub gen_info($); 79sub process_dafile($); 80sub match_filename($@); 81sub solve_ambiguous_match($$$); 82sub split_filename($); 83sub solve_relative_path($$); 84sub get_dir($); 85sub read_gcov_header($); 86sub read_gcov_file($); 87sub read_bb_file($$); 88sub read_string(*$); 89sub read_gcno_file($$); 90sub read_gcno_string(*$); 91sub read_hammer_bbg_file($$); 92sub read_hammer_bbg_string(*$); 93sub unpack_int32($$); 94sub info(@); 95sub get_gcov_version(); 96sub system_no_output($@); 97sub read_config($); 98sub apply_config($); 99sub gen_initial_info($); 100sub process_graphfile($); 101sub warn_handler($); 102sub die_handler($); 103 104# Global variables 105our $gcov_version; 106our $graph_file_extension; 107our $data_file_extension; 108our @data_directory; 109our $test_name = ""; 110our $quiet; 111our $help; 112our $output_filename; 113our $base_directory; 114our $version; 115our $follow; 116our $checksum; 117our $no_checksum; 118our $preserve_paths; 119our $compat_libtool; 120our $no_compat_libtool; 121our $adjust_testname; 122our $config; # Configuration file contents 123our $compatibility; # Compatibility version flag - used to indicate 124 # non-standard GCOV data format versions 125our @ignore_errors; # List of errors to ignore (parameter) 126our @ignore; # List of errors to ignore (array) 127our $initial; 128our $no_recursion = 0; 129our $maxdepth; 130 131our $cwd = `pwd`; 132chomp($cwd); 133 134 135# 136# Code entry point 137# 138 139# Register handler routine to be called when interrupted 140$SIG{"INT"} = \&int_handler; 141$SIG{__WARN__} = \&warn_handler; 142$SIG{__DIE__} = \&die_handler; 143 144# Read configuration file if available 145if (-r $ENV{"HOME"}."/.lcovrc") 146{ 147 $config = read_config($ENV{"HOME"}."/.lcovrc"); 148} 149elsif (-r "/etc/lcovrc") 150{ 151 $config = read_config("/etc/lcovrc"); 152} 153 154if ($config) 155{ 156 # Copy configuration file values to variables 157 apply_config({ 158 "geninfo_gcov_tool" => \$gcov_tool, 159 "geninfo_adjust_testname" => \$adjust_testname, 160 "geninfo_checksum" => \$checksum, 161 "geninfo_no_checksum" => \$no_checksum, # deprecated 162 "geninfo_compat_libtool" => \$compat_libtool}); 163 164 # Merge options 165 if (defined($no_checksum)) 166 { 167 $checksum = ($no_checksum ? 0 : 1); 168 $no_checksum = undef; 169 } 170} 171 172# Parse command line options 173if (!GetOptions("test-name=s" => \$test_name, 174 "output-filename=s" => \$output_filename, 175 "checksum" => \$checksum, 176 "no-checksum" => \$no_checksum, 177 "base-directory=s" => \$base_directory, 178 "version" =>\$version, 179 "quiet" => \$quiet, 180 "help|?" => \$help, 181 "follow" => \$follow, 182 "compat-libtool" => \$compat_libtool, 183 "no-compat-libtool" => \$no_compat_libtool, 184 "gcov-tool=s" => \$gcov_tool, 185 "ignore-errors=s" => \@ignore_errors, 186 "initial|i" => \$initial, 187 "no-recursion" => \$no_recursion, 188 )) 189{ 190 print(STDERR "Use $tool_name --help to get usage information\n"); 191 exit(1); 192} 193else 194{ 195 # Merge options 196 if (defined($no_checksum)) 197 { 198 $checksum = ($no_checksum ? 0 : 1); 199 $no_checksum = undef; 200 } 201 202 if (defined($no_compat_libtool)) 203 { 204 $compat_libtool = ($no_compat_libtool ? 0 : 1); 205 $no_compat_libtool = undef; 206 } 207} 208 209@data_directory = @ARGV; 210 211# Check for help option 212if ($help) 213{ 214 print_usage(*STDOUT); 215 exit(0); 216} 217 218# Check for version option 219if ($version) 220{ 221 print("$tool_name: $lcov_version\n"); 222 exit(0); 223} 224 225# Make sure test names only contain valid characters 226if ($test_name =~ s/\W/_/g) 227{ 228 warn("WARNING: invalid characters removed from testname!\n"); 229} 230 231# Adjust test name to include uname output if requested 232if ($adjust_testname) 233{ 234 $test_name .= "__".`uname -a`; 235 $test_name =~ s/\W/_/g; 236} 237 238# Make sure base_directory contains an absolute path specification 239if ($base_directory) 240{ 241 $base_directory = solve_relative_path($cwd, $base_directory); 242} 243 244# Check for follow option 245if ($follow) 246{ 247 $follow = "-follow" 248} 249else 250{ 251 $follow = ""; 252} 253 254# Determine checksum mode 255if (defined($checksum)) 256{ 257 # Normalize to boolean 258 $checksum = ($checksum ? 1 : 0); 259} 260else 261{ 262 # Default is off 263 $checksum = 0; 264} 265 266# Determine libtool compatibility mode 267if (defined($compat_libtool)) 268{ 269 $compat_libtool = ($compat_libtool? 1 : 0); 270} 271else 272{ 273 # Default is on 274 $compat_libtool = 1; 275} 276 277# Determine max depth for recursion 278if ($no_recursion) 279{ 280 $maxdepth = "-maxdepth 1"; 281} 282else 283{ 284 $maxdepth = ""; 285} 286 287# Check for directory name 288if (!@data_directory) 289{ 290 die("No directory specified\n". 291 "Use $tool_name --help to get usage information\n"); 292} 293else 294{ 295 foreach (@data_directory) 296 { 297 stat($_); 298 if (!-r _) 299 { 300 die("ERROR: cannot read $_!\n"); 301 } 302 } 303} 304 305if (@ignore_errors) 306{ 307 my @expanded; 308 my $error; 309 310 # Expand comma-separated entries 311 foreach (@ignore_errors) { 312 if (/,/) 313 { 314 push(@expanded, split(",", $_)); 315 } 316 else 317 { 318 push(@expanded, $_); 319 } 320 } 321 322 foreach (@expanded) 323 { 324 /^gcov$/ && do { $ignore[$ERROR_GCOV] = 1; next; } ; 325 /^source$/ && do { $ignore[$ERROR_SOURCE] = 1; next; }; 326 die("ERROR: unknown argument for --ignore-errors: $_\n"); 327 } 328} 329 330if (system_no_output(3, $gcov_tool, "--help") == -1) 331{ 332 die("ERROR: need tool $gcov_tool!\n"); 333} 334 335$gcov_version = get_gcov_version(); 336 337if ($gcov_version < $GCOV_VERSION_3_4_0) 338{ 339 if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER) 340 { 341 $data_file_extension = ".da"; 342 $graph_file_extension = ".bbg"; 343 } 344 else 345 { 346 $data_file_extension = ".da"; 347 $graph_file_extension = ".bb"; 348 } 349} 350else 351{ 352 $data_file_extension = ".gcda"; 353 $graph_file_extension = ".gcno"; 354} 355 356# Check for availability of --preserve-paths option of gcov 357if (`$gcov_tool --help` =~ /--preserve-paths/) 358{ 359 $preserve_paths = "--preserve-paths"; 360} 361 362# Check output filename 363if (defined($output_filename) && ($output_filename ne "-")) 364{ 365 # Initially create output filename, data is appended 366 # for each data file processed 367 local *DUMMY_HANDLE; 368 open(DUMMY_HANDLE, ">$output_filename") 369 or die("ERROR: cannot create $output_filename!\n"); 370 close(DUMMY_HANDLE); 371 372 # Make $output_filename an absolute path because we're going 373 # to change directories while processing files 374 if (!($output_filename =~ /^\/(.*)$/)) 375 { 376 $output_filename = $cwd."/".$output_filename; 377 } 378} 379 380# Do something 381if ($initial) 382{ 383 foreach (@data_directory) 384 { 385 gen_initial_info($_); 386 } 387} 388else 389{ 390 foreach (@data_directory) 391 { 392 gen_info($_); 393 } 394} 395info("Finished .info-file creation\n"); 396 397exit(0); 398 399 400 401# 402# print_usage(handle) 403# 404# Print usage information. 405# 406 407sub print_usage(*) 408{ 409 local *HANDLE = $_[0]; 410 411 print(HANDLE <<END_OF_USAGE); 412Usage: $tool_name [OPTIONS] DIRECTORY 413 414Traverse DIRECTORY and create a .info file for each data file found. Note 415that you may specify more than one directory, all of which are then processed 416sequentially. 417 418 -h, --help Print this help, then exit 419 -v, --version Print version number, then exit 420 -q, --quiet Do not print progress messages 421 -i, --initial Capture initial zero coverage data 422 -t, --test-name NAME Use test case name NAME for resulting data 423 -o, --output-filename OUTFILE Write data only to OUTFILE 424 -f, --follow Follow links when searching .da/.gcda files 425 -b, --base-directory DIR Use DIR as base directory for relative paths 426 --(no-)checksum Enable (disable) line checksumming 427 --(no-)compat-libtool Enable (disable) libtool compatibility mode 428 --gcov-tool TOOL Specify gcov tool location 429 --ignore-errors ERROR Continue after ERROR (gcov, source) 430 --no-recursion Exlude subdirectories from processing 431 --function-coverage Capture function call counts 432 433For more information see: $lcov_url 434END_OF_USAGE 435 ; 436} 437 438 439# 440# gen_info(directory) 441# 442# Traverse DIRECTORY and create a .info file for each data file found. 443# The .info file contains TEST_NAME in the following format: 444# 445# TN:<test name> 446# 447# For each source file name referenced in the data file, there is a section 448# containing source code and coverage data: 449# 450# SF:<absolute path to the source file> 451# FN:<line number of function start>,<function name> for each function 452# DA:<line number>,<execution count> for each instrumented line 453# LH:<number of lines with an execution count> greater than 0 454# LF:<number of instrumented lines> 455# 456# Sections are separated by: 457# 458# end_of_record 459# 460# In addition to the main source code file there are sections for each 461# #included file containing executable code. Note that the absolute path 462# of a source file is generated by interpreting the contents of the respective 463# graph file. Relative filenames are prefixed with the directory in which the 464# graph file is found. Note also that symbolic links to the graph file will be 465# resolved so that the actual file path is used instead of the path to a link. 466# This approach is necessary for the mechanism to work with the /proc/gcov 467# files. 468# 469# Die on error. 470# 471 472sub gen_info($) 473{ 474 my $directory = $_[0]; 475 my @file_list; 476 477 if (-d $directory) 478 { 479 info("Scanning $directory for $data_file_extension ". 480 "files ...\n"); 481 482 @file_list = `find "$directory" $maxdepth $follow -name \\*$data_file_extension -type f 2>/dev/null`; 483 chomp(@file_list); 484 @file_list or die("ERROR: no $data_file_extension files found ". 485 "in $directory!\n"); 486 info("Found %d data files in %s\n", $#file_list+1, $directory); 487 } 488 else 489 { 490 @file_list = ($directory); 491 } 492 493 # Process all files in list 494 foreach (@file_list) { process_dafile($_); } 495} 496 497 498# 499# process_dafile(da_filename) 500# 501# Create a .info file for a single data file. 502# 503# Die on error. 504# 505 506sub process_dafile($) 507{ 508 info("Processing %s\n", $_[0]); 509 510 my $da_filename; # Name of data file to process 511 my $da_dir; # Directory of data file 512 my $source_dir; # Directory of source file 513 my $da_basename; # data filename without ".da/.gcda" extension 514 my $bb_filename; # Name of respective graph file 515 my %bb_content; # Contents of graph file 516 my $gcov_error; # Error code of gcov tool 517 my $object_dir; # Directory containing all object files 518 my $source_filename; # Name of a source code file 519 my $gcov_file; # Name of a .gcov file 520 my @gcov_content; # Content of a .gcov file 521 my @gcov_branches; # Branch content of a .gcov file 522 my @gcov_functions; # Function calls of a .gcov file 523 my @gcov_list; # List of generated .gcov files 524 my $line_number; # Line number count 525 my $lines_hit; # Number of instrumented lines hit 526 my $lines_found; # Number of instrumented lines found 527 my $funcs_hit; # Number of instrumented functions hit 528 my $funcs_found; # Number of instrumented functions found 529 my $source; # gcov source header information 530 my $object; # gcov object header information 531 my @matches; # List of absolute paths matching filename 532 my @unprocessed; # List of unprocessed source code files 533 my $base_dir; # Base directory for current file 534 my @result; 535 my $index; 536 my $da_renamed; # If data file is to be renamed 537 local *INFO_HANDLE; 538 539 # Get path to data file in absolute and normalized form (begins with /, 540 # contains no more ../ or ./) 541 $da_filename = solve_relative_path($cwd, $_[0]); 542 543 # Get directory and basename of data file 544 ($da_dir, $da_basename) = split_filename($da_filename); 545 546 # avoid files from .libs dirs 547 if ($compat_libtool && $da_dir =~ m/(.*)\/\.libs$/) { 548 $source_dir = $1; 549 } else { 550 $source_dir = $da_dir; 551 } 552 553 if (-z $da_filename) 554 { 555 $da_renamed = 1; 556 } 557 else 558 { 559 $da_renamed = 0; 560 } 561 562 # Construct base_dir for current file 563 if ($base_directory) 564 { 565 $base_dir = $base_directory; 566 } 567 else 568 { 569 $base_dir = $source_dir; 570 } 571 572 # Check for writable $base_dir (gcov will try to write files there) 573 stat($base_dir); 574 if (!-w _) 575 { 576 die("ERROR: cannot write to directory $base_dir!\n"); 577 } 578 579 # Construct name of graph file 580 $bb_filename = $da_dir."/".$da_basename.$graph_file_extension; 581 582 # Find out the real location of graph file in case we're just looking at 583 # a link 584 while (readlink($bb_filename)) 585 { 586 my $last_dir = dirname($bb_filename); 587 588 $bb_filename = readlink($bb_filename); 589 $bb_filename = solve_relative_path($last_dir, $bb_filename); 590 } 591 592 # Ignore empty graph file (e.g. source file with no statement) 593 if (-z $bb_filename) 594 { 595 warn("WARNING: empty $bb_filename (skipped)\n"); 596 return; 597 } 598 599 # Read contents of graph file into hash. We need it later to find out 600 # the absolute path to each .gcov file created as well as for 601 # information about functions and their source code positions. 602 if ($gcov_version < $GCOV_VERSION_3_4_0) 603 { 604 if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER) 605 { 606 %bb_content = read_hammer_bbg_file($bb_filename, 607 $base_dir); 608 } 609 else 610 { 611 %bb_content = read_bb_file($bb_filename, $base_dir); 612 } 613 } 614 else 615 { 616 %bb_content = read_gcno_file($bb_filename, $base_dir); 617 } 618 619 # Set $object_dir to real location of object files. This may differ 620 # from $da_dir if the graph file is just a link to the "real" object 621 # file location. 622 $object_dir = dirname($bb_filename); 623 624 # Is the data file in a different directory? (this happens e.g. with 625 # the gcov-kernel patch) 626 if ($object_dir ne $da_dir) 627 { 628 # Need to create link to data file in $object_dir 629 system("ln", "-s", $da_filename, 630 "$object_dir/$da_basename$data_file_extension") 631 and die ("ERROR: cannot create link $object_dir/". 632 "$da_basename$data_file_extension!\n"); 633 } 634 635 # Change to directory containing data files and apply GCOV 636 chdir($base_dir); 637 638 if ($da_renamed) 639 { 640 # Need to rename empty data file to workaround 641 # gcov <= 3.2.x bug (Abort) 642 system_no_output(3, "mv", "$da_filename", "$da_filename.ori") 643 and die ("ERROR: cannot rename $da_filename\n"); 644 } 645 646 # Execute gcov command and suppress standard output 647 if ($preserve_paths) 648 { 649 $gcov_error = system_no_output(1, $gcov_tool, $da_filename, 650 "-o", $object_dir, 651 "--preserve-paths", 652 "-b"); 653 } 654 else 655 { 656 $gcov_error = system_no_output(1, $gcov_tool, $da_filename, 657 "-o", $object_dir, 658 "-b"); 659 } 660 661 if ($da_renamed) 662 { 663 system_no_output(3, "mv", "$da_filename.ori", "$da_filename") 664 and die ("ERROR: cannot rename $da_filename.ori"); 665 } 666 667 # Clean up link 668 if ($object_dir ne $da_dir) 669 { 670 unlink($object_dir."/".$da_basename.$data_file_extension); 671 } 672 673 if ($gcov_error) 674 { 675 if ($ignore[$ERROR_GCOV]) 676 { 677 warn("WARNING: GCOV failed for $da_filename!\n"); 678 return; 679 } 680 die("ERROR: GCOV failed for $da_filename!\n"); 681 } 682 683 # Collect data from resulting .gcov files and create .info file 684 @gcov_list = glob("*.gcov"); 685 686 # Check for files 687 if (!@gcov_list) 688 { 689 warn("WARNING: gcov did not create any files for ". 690 "$da_filename!\n"); 691 } 692 693 # Check whether we're writing to a single file 694 if ($output_filename) 695 { 696 if ($output_filename eq "-") 697 { 698 *INFO_HANDLE = *STDOUT; 699 } 700 else 701 { 702 # Append to output file 703 open(INFO_HANDLE, ">>$output_filename") 704 or die("ERROR: cannot write to ". 705 "$output_filename!\n"); 706 } 707 } 708 else 709 { 710 # Open .info file for output 711 open(INFO_HANDLE, ">$da_filename.info") 712 or die("ERROR: cannot create $da_filename.info!\n"); 713 } 714 715 # Write test name 716 printf(INFO_HANDLE "TN:%s\n", $test_name); 717 718 # Traverse the list of generated .gcov files and combine them into a 719 # single .info file 720 @unprocessed = keys(%bb_content); 721 foreach $gcov_file (@gcov_list) 722 { 723 ($source, $object) = read_gcov_header($gcov_file); 724 725 if (defined($source)) 726 { 727 $source = solve_relative_path($base_dir, $source); 728 } 729 730 # gcov will happily create output even if there's no source code 731 # available - this interferes with checksum creation so we need 732 # to pull the emergency brake here. 733 if (defined($source) && ! -r $source && $checksum) 734 { 735 if ($ignore[$ERROR_SOURCE]) 736 { 737 warn("WARNING: could not read source file ". 738 "$source\n"); 739 next; 740 } 741 die("ERROR: could not read source file $source\n"); 742 } 743 744 @matches = match_filename(defined($source) ? $source : 745 $gcov_file, keys(%bb_content)); 746 747 # Skip files that are not mentioned in the graph file 748 if (!@matches) 749 { 750 warn("WARNING: cannot find an entry for ".$gcov_file. 751 " in $graph_file_extension file, skipping ". 752 "file!\n"); 753 unlink($gcov_file); 754 next; 755 } 756 757 # Read in contents of gcov file 758 @result = read_gcov_file($gcov_file); 759 @gcov_content = @{$result[0]}; 760 @gcov_branches = @{$result[1]}; 761 @gcov_functions = @{$result[2]}; 762 763 # Skip empty files 764 if (!@gcov_content) 765 { 766 warn("WARNING: skipping empty file ".$gcov_file."\n"); 767 unlink($gcov_file); 768 next; 769 } 770 771 if (scalar(@matches) == 1) 772 { 773 # Just one match 774 $source_filename = $matches[0]; 775 } 776 else 777 { 778 # Try to solve the ambiguity 779 $source_filename = solve_ambiguous_match($gcov_file, 780 \@matches, \@gcov_content); 781 } 782 783 # Remove processed file from list 784 for ($index = scalar(@unprocessed) - 1; $index >= 0; $index--) 785 { 786 if ($unprocessed[$index] eq $source_filename) 787 { 788 splice(@unprocessed, $index, 1); 789 last; 790 } 791 } 792 793 # Write absolute path of source file 794 printf(INFO_HANDLE "SF:%s\n", $source_filename); 795 796 # Write function-related information 797 if (defined($bb_content{$source_filename})) 798 { 799 foreach (split(",",$bb_content{$source_filename})) 800 { 801 my ($fn, $line) = split("=", $_); 802 803 if ($fn eq "") { 804 next; 805 } 806 807 # Normalize function name 808 $fn =~ s/\W/_/g; 809 810 print(INFO_HANDLE "FN:$line,$fn\n"); 811 } 812 } 813 814 #-- 815 #-- FNDA: <call-count>, <function-name> 816 #-- FNF: overall count of functions 817 #-- FNH: overall count of functions with non-zero call count 818 #-- 819 $funcs_found = 0; 820 $funcs_hit = 0; 821 while (@gcov_functions) 822 { 823 printf(INFO_HANDLE "FNDA:%s,%s\n", 824 $gcov_functions[0], 825 $gcov_functions[1]); 826 $funcs_found++; 827 $funcs_hit++ if $gcov_functions[0]; 828 splice(@gcov_functions,0,2); 829 } 830 if ($funcs_found > 0) { 831 printf(INFO_HANDLE "FNF:%s\n", $funcs_found); 832 printf(INFO_HANDLE "FNH:%s\n", $funcs_hit); 833 } 834 835 # Reset line counters 836 $line_number = 0; 837 $lines_found = 0; 838 $lines_hit = 0; 839 840 # Write coverage information for each instrumented line 841 # Note: @gcov_content contains a list of (flag, count, source) 842 # tuple for each source code line 843 while (@gcov_content) 844 { 845 $line_number++; 846 847 # Check for instrumented line 848 if ($gcov_content[0]) 849 { 850 $lines_found++; 851 printf(INFO_HANDLE "DA:".$line_number.",". 852 $gcov_content[1].($checksum ? 853 ",". md5_base64($gcov_content[2]) : ""). 854 "\n"); 855 856 # Increase $lines_hit in case of an execution 857 # count>0 858 if ($gcov_content[1] > 0) { $lines_hit++; } 859 } 860 861 # Remove already processed data from array 862 splice(@gcov_content,0,3); 863 } 864 865 #-- 866 #-- BA: <code-line>, <branch-coverage> 867 #-- 868 #-- print one BA line for every branch of a 869 #-- conditional. <branch-coverage> values 870 #-- are: 871 #-- 0 - not executed 872 #-- 1 - executed but not taken 873 #-- 2 - executed and taken 874 #-- 875 while (@gcov_branches) 876 { 877 if ($gcov_branches[0]) 878 { 879 printf(INFO_HANDLE "BA:%s,%s\n", 880 $gcov_branches[0], 881 $gcov_branches[1]); 882 } 883 splice(@gcov_branches,0,2); 884 } 885 886 # Write line statistics and section separator 887 printf(INFO_HANDLE "LF:%s\n", $lines_found); 888 printf(INFO_HANDLE "LH:%s\n", $lines_hit); 889 print(INFO_HANDLE "end_of_record\n"); 890 891 # Remove .gcov file after processing 892 unlink($gcov_file); 893 } 894 895 # Check for files which show up in the graph file but were never 896 # processed 897 if (@unprocessed && @gcov_list) 898 { 899 foreach (@unprocessed) 900 { 901 warn("WARNING: no data found for $_\n"); 902 } 903 } 904 905 if (!($output_filename && ($output_filename eq "-"))) 906 { 907 close(INFO_HANDLE); 908 } 909 910 # Change back to initial directory 911 chdir($cwd); 912} 913 914 915# 916# solve_relative_path(path, dir) 917# 918# Solve relative path components of DIR which, if not absolute, resides in PATH. 919# 920 921sub solve_relative_path($$) 922{ 923 my $path = $_[0]; 924 my $dir = $_[1]; 925 my $result; 926 927 $result = $dir; 928 # Prepend path if not absolute 929 if ($dir =~ /^[^\/]/) 930 { 931 $result = "$path/$result"; 932 } 933 934 # Remove // 935 $result =~ s/\/\//\//g; 936 937 # Remove . 938 $result =~ s/\/\.\//\//g; 939 940 # Solve .. 941 while ($result =~ s/\/[^\/]+\/\.\.\//\//) 942 { 943 } 944 945 # Remove preceding .. 946 $result =~ s/^\/\.\.\//\//g; 947 948 return $result; 949} 950 951 952# 953# match_filename(gcov_filename, list) 954# 955# Return a list of those entries of LIST which match the relative filename 956# GCOV_FILENAME. 957# 958 959sub match_filename($@) 960{ 961 my $filename = shift; 962 my @list = @_; 963 my @result; 964 965 $filename =~ s/^(.*).gcov$/$1/; 966 967 if ($filename =~ /^\/(.*)$/) 968 { 969 $filename = "$1"; 970 } 971 972 foreach (@list) 973 { 974 if (/\/\Q$filename\E(.*)$/ && $1 eq "") 975 { 976 @result = (@result, $_); 977 } 978 } 979 return @result; 980} 981 982 983# 984# solve_ambiguous_match(rel_filename, matches_ref, gcov_content_ref) 985# 986# Try to solve ambiguous matches of mapping (gcov file) -> (source code) file 987# by comparing source code provided in the GCOV file with that of the files 988# in MATCHES. REL_FILENAME identifies the relative filename of the gcov 989# file. 990# 991# Return the one real match or die if there is none. 992# 993 994sub solve_ambiguous_match($$$) 995{ 996 my $rel_name = $_[0]; 997 my $matches = $_[1]; 998 my $content = $_[2]; 999 my $filename; 1000 my $index; 1001 my $no_match; 1002 local *SOURCE; 1003 1004 # Check the list of matches 1005 foreach $filename (@$matches) 1006 { 1007 1008 # Compare file contents 1009 open(SOURCE, $filename) 1010 or die("ERROR: cannot read $filename!\n"); 1011 1012 $no_match = 0; 1013 for ($index = 2; <SOURCE>; $index += 3) 1014 { 1015 chomp; 1016 1017 if ($_ ne @$content[$index]) 1018 { 1019 $no_match = 1; 1020 last; 1021 } 1022 } 1023 1024 close(SOURCE); 1025 1026 if (!$no_match) 1027 { 1028 info("Solved source file ambiguity for $rel_name\n"); 1029 return $filename; 1030 } 1031 } 1032 1033 die("ERROR: could not match gcov data for $rel_name!\n"); 1034} 1035 1036 1037# 1038# split_filename(filename) 1039# 1040# Return (path, filename, extension) for a given FILENAME. 1041# 1042 1043sub split_filename($) 1044{ 1045 my @path_components = split('/', $_[0]); 1046 my @file_components = split('\.', pop(@path_components)); 1047 my $extension = pop(@file_components); 1048 1049 return (join("/",@path_components), join(".",@file_components), 1050 $extension); 1051} 1052 1053 1054# 1055# get_dir(filename); 1056# 1057# Return the directory component of a given FILENAME. 1058# 1059 1060sub get_dir($) 1061{ 1062 my @components = split("/", $_[0]); 1063 pop(@components); 1064 1065 return join("/", @components); 1066} 1067 1068 1069# 1070# read_gcov_header(gcov_filename) 1071# 1072# Parse file GCOV_FILENAME and return a list containing the following 1073# information: 1074# 1075# (source, object) 1076# 1077# where: 1078# 1079# source: complete relative path of the source code file (gcc >= 3.3 only) 1080# object: name of associated graph file 1081# 1082# Die on error. 1083# 1084 1085sub read_gcov_header($) 1086{ 1087 my $source; 1088 my $object; 1089 local *INPUT; 1090 1091 if (!open(INPUT, $_[0])) 1092 { 1093 if ($ignore_errors[$ERROR_GCOV]) 1094 { 1095 warn("WARNING: cannot read $_[0]!\n"); 1096 return (undef,undef); 1097 } 1098 die("ERROR: cannot read $_[0]!\n"); 1099 } 1100 1101 while (<INPUT>) 1102 { 1103 chomp($_); 1104 1105 if (/^\s+-:\s+0:Source:(.*)$/) 1106 { 1107 # Source: header entry 1108 $source = $1; 1109 } 1110 elsif (/^\s+-:\s+0:Object:(.*)$/) 1111 { 1112 # Object: header entry 1113 $object = $1; 1114 } 1115 else 1116 { 1117 last; 1118 } 1119 } 1120 1121 close(INPUT); 1122 1123 return ($source, $object); 1124} 1125 1126 1127# 1128# read_gcov_file(gcov_filename) 1129# 1130# Parse file GCOV_FILENAME (.gcov file format) and return the list: 1131# (reference to gcov_content, reference to gcov_branch, reference to gcov_func) 1132# 1133# gcov_content is a list of 3 elements 1134# (flag, count, source) for each source code line: 1135# 1136# $result[($line_number-1)*3+0] = instrumentation flag for line $line_number 1137# $result[($line_number-1)*3+1] = execution count for line $line_number 1138# $result[($line_number-1)*3+2] = source code text for line $line_number 1139# 1140# gcov_branch is a list of 2 elements 1141# (linenumber, branch result) for each branch 1142# 1143# gcov_func is a list of 2 elements 1144# (number of calls, function name) for each function 1145# 1146# Die on error. 1147# 1148 1149sub read_gcov_file($) 1150{ 1151 my $filename = $_[0]; 1152 my @result = (); 1153 my @branches = (); 1154 my @functions = (); 1155 my $number; 1156 local *INPUT; 1157 1158 open(INPUT, $filename) 1159 or die("ERROR: cannot read $filename!\n"); 1160 1161 if ($gcov_version < $GCOV_VERSION_3_3_0) 1162 { 1163 # Expect gcov format as used in gcc < 3.3 1164 while (<INPUT>) 1165 { 1166 chomp($_); 1167 1168 if (/^\t\t(.*)$/) 1169 { 1170 # Uninstrumented line 1171 push(@result, 0); 1172 push(@result, 0); 1173 push(@result, $1); 1174 } 1175 elsif (/^branch/) 1176 { 1177 # Branch execution data 1178 push(@branches, scalar(@result) / 3); 1179 if (/^branch \d+ never executed$/) 1180 { 1181 push(@branches, 0); 1182 } 1183 elsif (/^branch \d+ taken = 0%/) 1184 { 1185 push(@branches, 1); 1186 } 1187 else 1188 { 1189 push(@branches, 2); 1190 } 1191 } 1192 elsif (/^call/ || /^function/) 1193 { 1194 # Function call return data 1195 } 1196 else 1197 { 1198 # Source code execution data 1199 $number = (split(" ",substr($_, 0, 16)))[0]; 1200 1201 # Check for zero count which is indicated 1202 # by ###### 1203 if ($number eq "######") { $number = 0; } 1204 1205 push(@result, 1); 1206 push(@result, $number); 1207 push(@result, substr($_, 16)); 1208 } 1209 } 1210 } 1211 else 1212 { 1213 # Expect gcov format as used in gcc >= 3.3 1214 while (<INPUT>) 1215 { 1216 chomp($_); 1217 1218 if (/^branch\s+\d+\s+(\S+)\s+(\S+)/) 1219 { 1220 # Branch execution data 1221 push(@branches, scalar(@result) / 3); 1222 if ($1 eq "never") 1223 { 1224 push(@branches, 0); 1225 } 1226 elsif ($2 eq "0%") 1227 { 1228 push(@branches, 1); 1229 } 1230 else 1231 { 1232 push(@branches, 2); 1233 } 1234 } 1235 elsif (/^function\s+(\S+)\s+called\s+(\d+)/) 1236 { 1237 push(@functions, $2, $1); 1238 } 1239 elsif (/^call/) 1240 { 1241 # Function call return data 1242 } 1243 elsif (/^\s*([^:]+):\s*([^:]+):(.*)$/) 1244 { 1245 # <exec count>:<line number>:<source code> 1246 if ($2 eq "0") 1247 { 1248 # Extra data 1249 } 1250 elsif ($1 eq "-") 1251 { 1252 # Uninstrumented line 1253 push(@result, 0); 1254 push(@result, 0); 1255 push(@result, $3); 1256 } 1257 else 1258 { 1259 # Source code execution data 1260 $number = $1; 1261 1262 # Check for zero count 1263 if ($number eq "#####") { $number = 0; } 1264 1265 push(@result, 1); 1266 push(@result, $number); 1267 push(@result, $3); 1268 } 1269 } 1270 } 1271 } 1272 1273 close(INPUT); 1274 return(\@result, \@branches, \@functions); 1275} 1276 1277 1278# 1279# read_bb_file(bb_filename, base_dir) 1280# 1281# Read .bb file BB_FILENAME and return a hash containing the following 1282# mapping: 1283# 1284# filename -> comma-separated list of pairs (function name=starting 1285# line number) to indicate the starting line of a function or 1286# =name to indicate an instrumented line 1287# 1288# for each entry in the .bb file. Filenames are absolute, i.e. relative 1289# filenames are prefixed with BASE_DIR. 1290# 1291# Die on error. 1292# 1293 1294sub read_bb_file($$) 1295{ 1296 my $bb_filename = $_[0]; 1297 my $base_dir = $_[1]; 1298 my %result; 1299 my $filename; 1300 my $function_name; 1301 my $minus_one = sprintf("%d", 0x80000001); 1302 my $minus_two = sprintf("%d", 0x80000002); 1303 my $value; 1304 my $packed_word; 1305 local *INPUT; 1306 1307 open(INPUT, $bb_filename) 1308 or die("ERROR: cannot read $bb_filename!\n"); 1309 1310 binmode(INPUT); 1311 1312 # Read data in words of 4 bytes 1313 while (read(INPUT, $packed_word, 4) == 4) 1314 { 1315 # Decode integer in intel byteorder 1316 $value = unpack_int32($packed_word, 0); 1317 1318 # Note: the .bb file format is documented in GCC info pages 1319 if ($value == $minus_one) 1320 { 1321 # Filename follows 1322 $filename = read_string(*INPUT, $minus_one) 1323 or die("ERROR: incomplete filename in ". 1324 "$bb_filename!\n"); 1325 1326 # Make path absolute 1327 $filename = solve_relative_path($base_dir, $filename); 1328 1329 # Insert into hash if not yet present. 1330 # This is necessary because functions declared as 1331 # "inline" are not listed as actual functions in 1332 # .bb files 1333 if (!$result{$filename}) 1334 { 1335 $result{$filename}=""; 1336 } 1337 } 1338 elsif ($value == $minus_two) 1339 { 1340 # Function name follows 1341 $function_name = read_string(*INPUT, $minus_two) 1342 or die("ERROR: incomplete function ". 1343 "name in $bb_filename!\n"); 1344 $function_name =~ s/\W/_/g; 1345 } 1346 elsif ($value > 0) 1347 { 1348 if (defined($filename)) 1349 { 1350 $result{$filename} .= 1351 ($result{$filename} ? "," : ""). 1352 "=$value"; 1353 } 1354 else 1355 { 1356 warn("WARNING: unassigned line". 1357 " number in .bb file ". 1358 "$bb_filename\n"); 1359 } 1360 if ($function_name) 1361 { 1362 # Got a full entry filename, funcname, lineno 1363 # Add to resulting hash 1364 1365 $result{$filename}.= 1366 ($result{$filename} ? "," : ""). 1367 join("=",($function_name,$value)); 1368 undef($function_name); 1369 } 1370 } 1371 } 1372 close(INPUT); 1373 1374 if (!scalar(keys(%result))) 1375 { 1376 die("ERROR: no data found in $bb_filename!\n"); 1377 } 1378 return %result; 1379} 1380 1381 1382# 1383# read_string(handle, delimiter); 1384# 1385# Read and return a string in 4-byte chunks from HANDLE until DELIMITER 1386# is found. 1387# 1388# Return empty string on error. 1389# 1390 1391sub read_string(*$) 1392{ 1393 my $HANDLE = $_[0]; 1394 my $delimiter = $_[1]; 1395 my $string = ""; 1396 my $packed_word; 1397 my $value; 1398 1399 while (read($HANDLE,$packed_word,4) == 4) 1400 { 1401 $value = unpack_int32($packed_word, 0); 1402 1403 if ($value == $delimiter) 1404 { 1405 # Remove trailing nil bytes 1406 $/="\0"; 1407 while (chomp($string)) {}; 1408 $/="\n"; 1409 return($string); 1410 } 1411 1412 $string = $string.$packed_word; 1413 } 1414 return(""); 1415} 1416 1417 1418# 1419# read_gcno_file(bb_filename, base_dir) 1420# 1421# Read .gcno file BB_FILENAME and return a hash containing the following 1422# mapping: 1423# 1424# filename -> comma-separated list of pairs (function name=starting 1425# line number) to indicate the starting line of a function or 1426# =name to indicate an instrumented line 1427# 1428# for each entry in the .gcno file. Filenames are absolute, i.e. relative 1429# filenames are prefixed with BASE_DIR. 1430# 1431# Die on error. 1432# 1433 1434sub read_gcno_file($$) 1435{ 1436 my $gcno_filename = $_[0]; 1437 my $base_dir = $_[1]; 1438 my %result; 1439 my $filename; 1440 my $function_name; 1441 my $lineno; 1442 my $length; 1443 my $value; 1444 my $endianness; 1445 my $blocks; 1446 my $packed_word; 1447 my $string; 1448 local *INPUT; 1449 1450 open(INPUT, $gcno_filename) 1451 or die("ERROR: cannot read $gcno_filename!\n"); 1452 1453 binmode(INPUT); 1454 1455 read(INPUT, $packed_word, 4) == 4 1456 or die("ERROR: Invalid gcno file format\n"); 1457 1458 $value = unpack_int32($packed_word, 0); 1459 $endianness = !($value == $GCNO_FILE_MAGIC); 1460 1461 unpack_int32($packed_word, $endianness) == $GCNO_FILE_MAGIC 1462 or die("ERROR: gcno file magic does not match\n"); 1463 1464 seek(INPUT, 8, 1); 1465 1466 # Read data in words of 4 bytes 1467 while (read(INPUT, $packed_word, 4) == 4) 1468 { 1469 # Decode integer in intel byteorder 1470 $value = unpack_int32($packed_word, $endianness); 1471 1472 if ($value == $GCNO_FUNCTION_TAG) 1473 { 1474 # skip length, ident and checksum 1475 seek(INPUT, 12, 1); 1476 (undef, $function_name) = 1477 read_gcno_string(*INPUT, $endianness); 1478 $function_name =~ s/\W/_/g; 1479 (undef, $filename) = 1480 read_gcno_string(*INPUT, $endianness); 1481 $filename = solve_relative_path($base_dir, $filename); 1482 1483 read(INPUT, $packed_word, 4); 1484 $lineno = unpack_int32($packed_word, $endianness); 1485 1486 $result{$filename}.= 1487 ($result{$filename} ? "," : ""). 1488 join("=",($function_name,$lineno)); 1489 } 1490 elsif ($value == $GCNO_LINES_TAG) 1491 { 1492 # Check for names of files containing inlined code 1493 # included in this file 1494 read(INPUT, $packed_word, 4); 1495 $length = unpack_int32($packed_word, $endianness); 1496 if ($length > 0) 1497 { 1498 # Block number 1499 read(INPUT, $packed_word, 4); 1500 $length--; 1501 } 1502 while ($length > 0) 1503 { 1504 read(INPUT, $packed_word, 4); 1505 $lineno = unpack_int32($packed_word, 1506 $endianness); 1507 $length--; 1508 if ($lineno != 0) 1509 { 1510 if (defined($filename)) 1511 { 1512 $result{$filename} .= 1513 ($result{$filename} ? "," : ""). 1514 "=$lineno"; 1515 } 1516 else 1517 { 1518 warn("WARNING: unassigned line". 1519 " number in .gcno file ". 1520 "$gcno_filename\n"); 1521 } 1522 next; 1523 } 1524 last if ($length == 0); 1525 ($blocks, $string) = 1526 read_gcno_string(*INPUT, $endianness); 1527 if (defined($string)) 1528 { 1529 $filename = $string; 1530 } 1531 if ($blocks > 1) 1532 { 1533 $filename = solve_relative_path( 1534 $base_dir, $filename); 1535 if (!defined($result{$filename})) 1536 { 1537 $result{$filename} = ""; 1538 } 1539 } 1540 $length -= $blocks; 1541 } 1542 } 1543 else 1544 { 1545 read(INPUT, $packed_word, 4); 1546 $length = unpack_int32($packed_word, $endianness); 1547 seek(INPUT, 4 * $length, 1); 1548 } 1549 } 1550 close(INPUT); 1551 1552 if (!scalar(keys(%result))) 1553 { 1554 die("ERROR: no data found in $gcno_filename!\n"); 1555 } 1556 return %result; 1557} 1558 1559 1560# 1561# read_gcno_string(handle, endianness); 1562# 1563# Read a string in 4-byte chunks from HANDLE. 1564# 1565# Return (number of 4-byte chunks read, string). 1566# 1567 1568sub read_gcno_string(*$) 1569{ 1570 my $handle = $_[0]; 1571 my $endianness = $_[1]; 1572 my $number_of_blocks = 0; 1573 my $string = ""; 1574 my $packed_word; 1575 1576 read($handle, $packed_word, 4) == 4 1577 or die("ERROR: reading string\n"); 1578 1579 $number_of_blocks = unpack_int32($packed_word, $endianness); 1580 1581 if ($number_of_blocks == 0) 1582 { 1583 return (1, undef); 1584 } 1585 1586 if (read($handle, $packed_word, 4 * $number_of_blocks) != 1587 4 * $number_of_blocks) 1588 { 1589 my $msg = "invalid string size ".(4 * $number_of_blocks)." in ". 1590 "gcno file at position ".tell($handle)."\n"; 1591 if ($ignore[$ERROR_SOURCE]) 1592 { 1593 warn("WARNING: $msg"); 1594 return (1, undef); 1595 } 1596 else 1597 { 1598 die("ERROR: $msg"); 1599 } 1600 } 1601 1602 $string = $string . $packed_word; 1603 1604 # Remove trailing nil bytes 1605 $/="\0"; 1606 while (chomp($string)) {}; 1607 $/="\n"; 1608 1609 return(1 + $number_of_blocks, $string); 1610} 1611 1612 1613# 1614# read_hammer_bbg_file(bb_filename, base_dir) 1615# 1616# Read .bbg file BB_FILENAME and return a hash containing the following 1617# mapping: 1618# 1619# filename -> comma-separated list of pairs (function name=starting 1620# line number) to indicate the starting line of a function or 1621# =name to indicate an instrumented line 1622# 1623# for each entry in the .bbg file. Filenames are absolute, i.e. relative 1624# filenames are prefixed with BASE_DIR. 1625# 1626# Die on error. 1627# 1628 1629sub read_hammer_bbg_file($$) 1630{ 1631 my $bbg_filename = $_[0]; 1632 my $base_dir = $_[1]; 1633 my %result; 1634 my $filename; 1635 my $function_name; 1636 my $first_line; 1637 my $lineno; 1638 my $length; 1639 my $value; 1640 my $endianness; 1641 my $blocks; 1642 my $packed_word; 1643 local *INPUT; 1644 1645 open(INPUT, $bbg_filename) 1646 or die("ERROR: cannot read $bbg_filename!\n"); 1647 1648 binmode(INPUT); 1649 1650 # Read magic 1651 read(INPUT, $packed_word, 4) == 4 1652 or die("ERROR: invalid bbg file format\n"); 1653 1654 $endianness = 1; 1655 1656 unpack_int32($packed_word, $endianness) == $BBG_FILE_MAGIC 1657 or die("ERROR: bbg file magic does not match\n"); 1658 1659 # Skip version 1660 seek(INPUT, 4, 1); 1661 1662 # Read data in words of 4 bytes 1663 while (read(INPUT, $packed_word, 4) == 4) 1664 { 1665 # Get record tag 1666 $value = unpack_int32($packed_word, $endianness); 1667 1668 # Get record length 1669 read(INPUT, $packed_word, 4); 1670 $length = unpack_int32($packed_word, $endianness); 1671 1672 if ($value == $GCNO_FUNCTION_TAG) 1673 { 1674 # Get function name 1675 ($value, $function_name) = 1676 read_hammer_bbg_string(*INPUT, $endianness); 1677 $function_name =~ s/\W/_/g; 1678 $filename = undef; 1679 $first_line = undef; 1680 1681 seek(INPUT, $length - $value * 4, 1); 1682 } 1683 elsif ($value == $GCNO_LINES_TAG) 1684 { 1685 # Get linenumber and filename 1686 # Skip block number 1687 seek(INPUT, 4, 1); 1688 $length -= 4; 1689 1690 while ($length > 0) 1691 { 1692 read(INPUT, $packed_word, 4); 1693 $lineno = unpack_int32($packed_word, 1694 $endianness); 1695 $length -= 4; 1696 if ($lineno != 0) 1697 { 1698 if (!defined($first_line)) 1699 { 1700 $first_line = $lineno; 1701 } 1702 if (defined($filename)) 1703 { 1704 $result{$filename} .= 1705 ($result{$filename} ? "," : ""). 1706 "=$lineno"; 1707 } 1708 else 1709 { 1710 warn("WARNING: unassigned line". 1711 " number in .bbg file ". 1712 "$bbg_filename\n"); 1713 } 1714 next; 1715 } 1716 ($blocks, $value) = 1717 read_hammer_bbg_string( 1718 *INPUT, $endianness); 1719 # Add all filenames to result list 1720 if (defined($value)) 1721 { 1722 $value = solve_relative_path( 1723 $base_dir, $value); 1724 if (!defined($result{$value})) 1725 { 1726 $result{$value} = undef; 1727 } 1728 if (!defined($filename)) 1729 { 1730 $filename = $value; 1731 } 1732 } 1733 $length -= $blocks * 4; 1734 1735 # Got a complete data set? 1736 if (defined($filename) && 1737 defined($first_line) && 1738 defined($function_name)) 1739 { 1740 # Add it to our result hash 1741 if (defined($result{$filename})) 1742 { 1743 $result{$filename} .= 1744 ",$function_name=$first_line"; 1745 } 1746 else 1747 { 1748 $result{$filename} = 1749 "$function_name=$first_line"; 1750 } 1751 $function_name = undef; 1752 $filename = undef; 1753 $first_line = undef; 1754 } 1755 } 1756 } 1757 else 1758 { 1759 # Skip other records 1760 seek(INPUT, $length, 1); 1761 } 1762 } 1763 close(INPUT); 1764 1765 if (!scalar(keys(%result))) 1766 { 1767 die("ERROR: no data found in $bbg_filename!\n"); 1768 } 1769 return %result; 1770} 1771 1772 1773# 1774# read_hammer_bbg_string(handle, endianness); 1775# 1776# Read a string in 4-byte chunks from HANDLE. 1777# 1778# Return (number of 4-byte chunks read, string). 1779# 1780 1781sub read_hammer_bbg_string(*$) 1782{ 1783 my $handle = $_[0]; 1784 my $endianness = $_[1]; 1785 my $length = 0; 1786 my $string = ""; 1787 my $packed_word; 1788 my $pad; 1789 1790 read($handle, $packed_word, 4) == 4 1791 or die("ERROR: reading string\n"); 1792 1793 $length = unpack_int32($packed_word, $endianness); 1794 $pad = 4 - $length % 4; 1795 1796 if ($length == 0) 1797 { 1798 return (1, undef); 1799 } 1800 1801 read($handle, $string, $length) == 1802 $length or die("ERROR: reading string\n"); 1803 seek($handle, $pad, 1); 1804 1805 return(1 + ($length + $pad) / 4, $string); 1806} 1807 1808# 1809# unpack_int32(word, endianness) 1810# 1811# Interpret 4-byte binary string WORD as signed 32 bit integer in 1812# endian encoding defined by ENDIANNESS (0=little, 1=big) and return its 1813# value. 1814# 1815 1816sub unpack_int32($$) 1817{ 1818 return sprintf("%d", unpack($_[1] ? "N" : "V",$_[0])); 1819} 1820 1821 1822# 1823# Get the GCOV tool version. Return an integer number which represents the 1824# GCOV version. Version numbers can be compared using standard integer 1825# operations. 1826# 1827 1828sub get_gcov_version() 1829{ 1830 local *HANDLE; 1831 my $version_string; 1832 my $result; 1833 1834 open(GCOV_PIPE, "$gcov_tool -v |") 1835 or die("ERROR: cannot retrieve gcov version!\n"); 1836 $version_string = <GCOV_PIPE>; 1837 close(GCOV_PIPE); 1838 1839 $result = 0; 1840 if ($version_string =~ /(\d+)\.(\d+)(\.(\d+))?/) 1841 { 1842 if (defined($4)) 1843 { 1844 info("Found gcov version: $1.$2.$4\n"); 1845 $result = $1 << 16 | $2 << 8 | $4; 1846 } 1847 else 1848 { 1849 info("Found gcov version: $1.$2\n"); 1850 $result = $1 << 16 | $2 << 8; 1851 } 1852 } 1853 if ($version_string =~ /suse/i && $result == 0x30303 || 1854 $version_string =~ /mandrake/i && $result == 0x30302) 1855 { 1856 info("Using compatibility mode for GCC 3.3 (hammer)\n"); 1857 $compatibility = $COMPAT_HAMMER; 1858 } 1859 return $result; 1860} 1861 1862 1863# 1864# info(printf_parameter) 1865# 1866# Use printf to write PRINTF_PARAMETER to stdout only when the $quiet flag 1867# is not set. 1868# 1869 1870sub info(@) 1871{ 1872 if (!$quiet) 1873 { 1874 # Print info string 1875 if (defined($output_filename) && ($output_filename eq "-")) 1876 { 1877 # Don't interfere with the .info output to STDOUT 1878 printf(STDERR @_); 1879 } 1880 else 1881 { 1882 printf(@_); 1883 } 1884 } 1885} 1886 1887 1888# 1889# int_handler() 1890# 1891# Called when the script was interrupted by an INT signal (e.g. CTRl-C) 1892# 1893 1894sub int_handler() 1895{ 1896 if ($cwd) { chdir($cwd); } 1897 info("Aborted.\n"); 1898 exit(1); 1899} 1900 1901 1902# 1903# system_no_output(mode, parameters) 1904# 1905# Call an external program using PARAMETERS while suppressing depending on 1906# the value of MODE: 1907# 1908# MODE & 1: suppress STDOUT 1909# MODE & 2: suppress STDERR 1910# 1911# Return 0 on success, non-zero otherwise. 1912# 1913 1914sub system_no_output($@) 1915{ 1916 my $mode = shift; 1917 my $result; 1918 local *OLD_STDERR; 1919 local *OLD_STDOUT; 1920 1921 # Save old stdout and stderr handles 1922 ($mode & 1) && open(OLD_STDOUT, ">>&STDOUT"); 1923 ($mode & 2) && open(OLD_STDERR, ">>&STDERR"); 1924 1925 # Redirect to /dev/null 1926 ($mode & 1) && open(STDOUT, ">/dev/null"); 1927 ($mode & 2) && open(STDERR, ">/dev/null"); 1928 1929 system(@_); 1930 $result = $?; 1931 1932 # Close redirected handles 1933 ($mode & 1) && close(STDOUT); 1934 ($mode & 2) && close(STDERR); 1935 1936 # Restore old handles 1937 ($mode & 1) && open(STDOUT, ">>&OLD_STDOUT"); 1938 ($mode & 2) && open(STDERR, ">>&OLD_STDERR"); 1939 1940 return $result; 1941} 1942 1943 1944# 1945# read_config(filename) 1946# 1947# Read configuration file FILENAME and return a reference to a hash containing 1948# all valid key=value pairs found. 1949# 1950 1951sub read_config($) 1952{ 1953 my $filename = $_[0]; 1954 my %result; 1955 my $key; 1956 my $value; 1957 local *HANDLE; 1958 1959 if (!open(HANDLE, "<$filename")) 1960 { 1961 warn("WARNING: cannot read configuration file $filename\n"); 1962 return undef; 1963 } 1964 while (<HANDLE>) 1965 { 1966 chomp; 1967 # Skip comments 1968 s/#.*//; 1969 # Remove leading blanks 1970 s/^\s+//; 1971 # Remove trailing blanks 1972 s/\s+$//; 1973 next unless length; 1974 ($key, $value) = split(/\s*=\s*/, $_, 2); 1975 if (defined($key) && defined($value)) 1976 { 1977 $result{$key} = $value; 1978 } 1979 else 1980 { 1981 warn("WARNING: malformed statement in line $. ". 1982 "of configuration file $filename\n"); 1983 } 1984 } 1985 close(HANDLE); 1986 return \%result; 1987} 1988 1989 1990# 1991# apply_config(REF) 1992# 1993# REF is a reference to a hash containing the following mapping: 1994# 1995# key_string => var_ref 1996# 1997# where KEY_STRING is a keyword and VAR_REF is a reference to an associated 1998# variable. If the global configuration hash CONFIG contains a value for 1999# keyword KEY_STRING, VAR_REF will be assigned the value for that keyword. 2000# 2001 2002sub apply_config($) 2003{ 2004 my $ref = $_[0]; 2005 2006 foreach (keys(%{$ref})) 2007 { 2008 if (defined($config->{$_})) 2009 { 2010 ${$ref->{$_}} = $config->{$_}; 2011 } 2012 } 2013} 2014 2015 2016sub gen_initial_info($) 2017{ 2018 my $directory = $_[0]; 2019 my @file_list; 2020 2021 if (-d $directory) 2022 { 2023 info("Scanning $directory for $graph_file_extension ". 2024 "files ...\n"); 2025 2026 @file_list = `find "$directory" $maxdepth $follow -name \\*$graph_file_extension -type f 2>/dev/null`; 2027 chomp(@file_list); 2028 @file_list or die("ERROR: no $graph_file_extension files ". 2029 "found in $directory!\n"); 2030 info("Found %d graph files in %s\n", $#file_list+1, $directory); 2031 } 2032 else 2033 { 2034 @file_list = ($directory); 2035 } 2036 2037 # Process all files in list 2038 foreach (@file_list) { process_graphfile($_); } 2039} 2040 2041sub process_graphfile($) 2042{ 2043 my $graph_filename = $_[0]; 2044 my $graph_dir; 2045 my $graph_basename; 2046 my $source_dir; 2047 my $base_dir; 2048 my %graph_data; 2049 my $filename; 2050 local *INFO_HANDLE; 2051 2052 info("Processing $_[0]\n"); 2053 2054 # Get path to data file in absolute and normalized form (begins with /, 2055 # contains no more ../ or ./) 2056 $graph_filename = solve_relative_path($cwd, $graph_filename); 2057 2058 # Get directory and basename of data file 2059 ($graph_dir, $graph_basename) = split_filename($graph_filename); 2060 2061 # avoid files from .libs dirs 2062 if ($compat_libtool && $graph_dir =~ m/(.*)\/\.libs$/) { 2063 $source_dir = $1; 2064 } else { 2065 $source_dir = $graph_dir; 2066 } 2067 2068 # Construct base_dir for current file 2069 if ($base_directory) 2070 { 2071 $base_dir = $base_directory; 2072 } 2073 else 2074 { 2075 $base_dir = $source_dir; 2076 } 2077 2078 if ($gcov_version < $GCOV_VERSION_3_4_0) 2079 { 2080 if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER) 2081 { 2082 %graph_data = read_hammer_bbg_file($graph_filename, 2083 $base_dir); 2084 } 2085 else 2086 { 2087 %graph_data = read_bb_file($graph_filename, $base_dir); 2088 } 2089 } 2090 else 2091 { 2092 %graph_data = read_gcno_file($graph_filename, $base_dir); 2093 } 2094 2095 # Check whether we're writing to a single file 2096 if ($output_filename) 2097 { 2098 if ($output_filename eq "-") 2099 { 2100 *INFO_HANDLE = *STDOUT; 2101 } 2102 else 2103 { 2104 # Append to output file 2105 open(INFO_HANDLE, ">>$output_filename") 2106 or die("ERROR: cannot write to ". 2107 "$output_filename!\n"); 2108 } 2109 } 2110 else 2111 { 2112 # Open .info file for output 2113 open(INFO_HANDLE, ">$graph_filename.info") 2114 or die("ERROR: cannot create $graph_filename.info!\n"); 2115 } 2116 2117 # Write test name 2118 printf(INFO_HANDLE "TN:%s\n", $test_name); 2119 foreach $filename (keys(%graph_data)) 2120 { 2121 my %lines; 2122 my $count = 0; 2123 my @functions; 2124 2125 print(INFO_HANDLE "SF:$filename\n"); 2126 2127 # Write function related data 2128 foreach (split(",",$graph_data{$filename})) 2129 { 2130 my ($fn, $line) = split("=", $_); 2131 2132 if ($fn eq "") 2133 { 2134 $lines{$line} = ""; 2135 next; 2136 } 2137 2138 # Normalize function name 2139 $fn =~ s/\W/_/g; 2140 2141 print(INFO_HANDLE "FN:$line,$fn\n"); 2142 push(@functions, $fn); 2143 } 2144 foreach (@functions) { 2145 print(INFO_HANDLE "FNDA:$_,0\n"); 2146 } 2147 print(INFO_HANDLE "FNF:".scalar(@functions)."\n"); 2148 print(INFO_HANDLE "FNH:0\n"); 2149 2150 # Write line related data 2151 foreach (sort {$a <=> $b } keys(%lines)) 2152 { 2153 print(INFO_HANDLE "DA:$_,0\n"); 2154 $count++; 2155 } 2156 print(INFO_HANDLE "LH:0\n"); 2157 print(INFO_HANDLE "LF:$count\n"); 2158 print(INFO_HANDLE "end_of_record\n"); 2159 } 2160 if (!($output_filename && ($output_filename eq "-"))) 2161 { 2162 close(INFO_HANDLE); 2163 } 2164} 2165 2166sub warn_handler($) 2167{ 2168 my ($msg) = @_; 2169 2170 warn("$tool_name: $msg"); 2171} 2172 2173sub die_handler($) 2174{ 2175 my ($msg) = @_; 2176 2177 die("$tool_name: $msg"); 2178} 2179