1#!/usr/bin/perl -w 2# 3# Copyright (c) International Business Machines Corp., 2002,2010 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 File::Spec::Functions qw /abs2rel catdir file_name_is_absolute splitdir 55 splitpath/; 56use Getopt::Long; 57use Digest::MD5 qw(md5_base64); 58 59 60# Constants 61our $lcov_version = 'LCOV version 1.9'; 62our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php"; 63our $gcov_tool = "gcov"; 64our $tool_name = basename($0); 65 66our $GCOV_VERSION_3_4_0 = 0x30400; 67our $GCOV_VERSION_3_3_0 = 0x30300; 68our $GCNO_FUNCTION_TAG = 0x01000000; 69our $GCNO_LINES_TAG = 0x01450000; 70our $GCNO_FILE_MAGIC = 0x67636e6f; 71our $BBG_FILE_MAGIC = 0x67626267; 72 73our $COMPAT_HAMMER = "hammer"; 74 75our $ERROR_GCOV = 0; 76our $ERROR_SOURCE = 1; 77our $ERROR_GRAPH = 2; 78 79our $EXCL_START = "LCOV_EXCL_START"; 80our $EXCL_STOP = "LCOV_EXCL_STOP"; 81our $EXCL_LINE = "LCOV_EXCL_LINE"; 82 83our $BR_LINE = 0; 84our $BR_BLOCK = 1; 85our $BR_BRANCH = 2; 86our $BR_TAKEN = 3; 87our $BR_VEC_ENTRIES = 4; 88our $BR_VEC_WIDTH = 32; 89 90our $UNNAMED_BLOCK = 9999; 91 92# Prototypes 93sub print_usage(*); 94sub gen_info($); 95sub process_dafile($$); 96sub match_filename($@); 97sub solve_ambiguous_match($$$); 98sub split_filename($); 99sub solve_relative_path($$); 100sub read_gcov_header($); 101sub read_gcov_file($); 102sub info(@); 103sub get_gcov_version(); 104sub system_no_output($@); 105sub read_config($); 106sub apply_config($); 107sub get_exclusion_data($); 108sub apply_exclusion_data($$); 109sub process_graphfile($$); 110sub filter_fn_name($); 111sub warn_handler($); 112sub die_handler($); 113sub graph_error($$); 114sub graph_expect($); 115sub graph_read(*$;$); 116sub graph_skip(*$;$); 117sub sort_uniq(@); 118sub sort_uniq_lex(@); 119sub graph_cleanup($); 120sub graph_find_base($); 121sub graph_from_bb($$$); 122sub graph_add_order($$$); 123sub read_bb_word(*;$); 124sub read_bb_value(*;$); 125sub read_bb_string(*$); 126sub read_bb($$); 127sub read_bbg_word(*;$); 128sub read_bbg_value(*;$); 129sub read_bbg_string(*); 130sub read_bbg_lines_record(*$$$$$$); 131sub read_bbg($$); 132sub read_gcno_word(*;$); 133sub read_gcno_value(*$;$); 134sub read_gcno_string(*$); 135sub read_gcno_lines_record(*$$$$$$$); 136sub read_gcno_function_record(*$$$$); 137sub read_gcno($$); 138sub get_gcov_capabilities(); 139sub get_overall_line($$$$); 140sub print_overall_rate($$$$$$$$$); 141sub br_gvec_len($); 142sub br_gvec_get($$); 143sub debug($); 144sub int_handler(); 145 146 147# Global variables 148our $gcov_version; 149our $graph_file_extension; 150our $data_file_extension; 151our @data_directory; 152our $test_name = ""; 153our $quiet; 154our $help; 155our $output_filename; 156our $base_directory; 157our $version; 158our $follow; 159our $checksum; 160our $no_checksum; 161our $compat_libtool; 162our $no_compat_libtool; 163our $adjust_testname; 164our $config; # Configuration file contents 165our $compatibility; # Compatibility version flag - used to indicate 166 # non-standard GCOV data format versions 167our @ignore_errors; # List of errors to ignore (parameter) 168our @ignore; # List of errors to ignore (array) 169our $initial; 170our $no_recursion = 0; 171our $maxdepth; 172our $no_markers = 0; 173our $opt_derive_func_data = 0; 174our $debug = 0; 175our $gcov_caps; 176our @gcov_options; 177 178our $cwd = `pwd`; 179chomp($cwd); 180 181 182# 183# Code entry point 184# 185 186# Register handler routine to be called when interrupted 187$SIG{"INT"} = \&int_handler; 188$SIG{__WARN__} = \&warn_handler; 189$SIG{__DIE__} = \&die_handler; 190 191# Prettify version string 192$lcov_version =~ s/\$\s*Revision\s*:?\s*(\S+)\s*\$/$1/; 193 194# Set LANG so that gcov output will be in a unified format 195$ENV{"LANG"} = "C"; 196 197# Read configuration file if available 198if (defined($ENV{"HOME"}) && (-r $ENV{"HOME"}."/.lcovrc")) 199{ 200 $config = read_config($ENV{"HOME"}."/.lcovrc"); 201} 202elsif (-r "/etc/lcovrc") 203{ 204 $config = read_config("/etc/lcovrc"); 205} 206 207if ($config) 208{ 209 # Copy configuration file values to variables 210 apply_config({ 211 "geninfo_gcov_tool" => \$gcov_tool, 212 "geninfo_adjust_testname" => \$adjust_testname, 213 "geninfo_checksum" => \$checksum, 214 "geninfo_no_checksum" => \$no_checksum, # deprecated 215 "geninfo_compat_libtool" => \$compat_libtool}); 216 217 # Merge options 218 if (defined($no_checksum)) 219 { 220 $checksum = ($no_checksum ? 0 : 1); 221 $no_checksum = undef; 222 } 223} 224 225# Parse command line options 226if (!GetOptions("test-name|t=s" => \$test_name, 227 "output-filename|o=s" => \$output_filename, 228 "checksum" => \$checksum, 229 "no-checksum" => \$no_checksum, 230 "base-directory|b=s" => \$base_directory, 231 "version|v" =>\$version, 232 "quiet|q" => \$quiet, 233 "help|h|?" => \$help, 234 "follow|f" => \$follow, 235 "compat-libtool" => \$compat_libtool, 236 "no-compat-libtool" => \$no_compat_libtool, 237 "gcov-tool=s" => \$gcov_tool, 238 "ignore-errors=s" => \@ignore_errors, 239 "initial|i" => \$initial, 240 "no-recursion" => \$no_recursion, 241 "no-markers" => \$no_markers, 242 "derive-func-data" => \$opt_derive_func_data, 243 "debug" => \$debug, 244 )) 245{ 246 print(STDERR "Use $tool_name --help to get usage information\n"); 247 exit(1); 248} 249else 250{ 251 # Merge options 252 if (defined($no_checksum)) 253 { 254 $checksum = ($no_checksum ? 0 : 1); 255 $no_checksum = undef; 256 } 257 258 if (defined($no_compat_libtool)) 259 { 260 $compat_libtool = ($no_compat_libtool ? 0 : 1); 261 $no_compat_libtool = undef; 262 } 263} 264 265@data_directory = @ARGV; 266 267# Check for help option 268if ($help) 269{ 270 print_usage(*STDOUT); 271 exit(0); 272} 273 274# Check for version option 275if ($version) 276{ 277 print("$tool_name: $lcov_version\n"); 278 exit(0); 279} 280 281# Make sure test names only contain valid characters 282if ($test_name =~ s/\W/_/g) 283{ 284 warn("WARNING: invalid characters removed from testname!\n"); 285} 286 287# Adjust test name to include uname output if requested 288if ($adjust_testname) 289{ 290 $test_name .= "__".`uname -a`; 291 $test_name =~ s/\W/_/g; 292} 293 294# Make sure base_directory contains an absolute path specification 295if ($base_directory) 296{ 297 $base_directory = solve_relative_path($cwd, $base_directory); 298} 299 300# Check for follow option 301if ($follow) 302{ 303 $follow = "-follow" 304} 305else 306{ 307 $follow = ""; 308} 309 310# Determine checksum mode 311if (defined($checksum)) 312{ 313 # Normalize to boolean 314 $checksum = ($checksum ? 1 : 0); 315} 316else 317{ 318 # Default is off 319 $checksum = 0; 320} 321 322# Determine libtool compatibility mode 323if (defined($compat_libtool)) 324{ 325 $compat_libtool = ($compat_libtool? 1 : 0); 326} 327else 328{ 329 # Default is on 330 $compat_libtool = 1; 331} 332 333# Determine max depth for recursion 334if ($no_recursion) 335{ 336 $maxdepth = "-maxdepth 1"; 337} 338else 339{ 340 $maxdepth = ""; 341} 342 343# Check for directory name 344if (!@data_directory) 345{ 346 die("No directory specified\n". 347 "Use $tool_name --help to get usage information\n"); 348} 349else 350{ 351 foreach (@data_directory) 352 { 353 stat($_); 354 if (!-r _) 355 { 356 die("ERROR: cannot read $_!\n"); 357 } 358 } 359} 360 361if (@ignore_errors) 362{ 363 my @expanded; 364 my $error; 365 366 # Expand comma-separated entries 367 foreach (@ignore_errors) { 368 if (/,/) 369 { 370 push(@expanded, split(",", $_)); 371 } 372 else 373 { 374 push(@expanded, $_); 375 } 376 } 377 378 foreach (@expanded) 379 { 380 /^gcov$/ && do { $ignore[$ERROR_GCOV] = 1; next; } ; 381 /^source$/ && do { $ignore[$ERROR_SOURCE] = 1; next; }; 382 /^graph$/ && do { $ignore[$ERROR_GRAPH] = 1; next; }; 383 die("ERROR: unknown argument for --ignore-errors: $_\n"); 384 } 385} 386 387if (system_no_output(3, $gcov_tool, "--help") == -1) 388{ 389 die("ERROR: need tool $gcov_tool!\n"); 390} 391 392$gcov_version = get_gcov_version(); 393 394if ($gcov_version < $GCOV_VERSION_3_4_0) 395{ 396 if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER) 397 { 398 $data_file_extension = ".da"; 399 $graph_file_extension = ".bbg"; 400 } 401 else 402 { 403 $data_file_extension = ".da"; 404 $graph_file_extension = ".bb"; 405 } 406} 407else 408{ 409 $data_file_extension = ".gcda"; 410 $graph_file_extension = ".gcno"; 411} 412 413# Determine gcov options 414$gcov_caps = get_gcov_capabilities(); 415push(@gcov_options, "-b") if ($gcov_caps->{'branch-probabilities'}); 416push(@gcov_options, "-c") if ($gcov_caps->{'branch-counts'}); 417push(@gcov_options, "-a") if ($gcov_caps->{'all-blocks'}); 418push(@gcov_options, "-p") if ($gcov_caps->{'preserve-paths'}); 419 420# Check output filename 421if (defined($output_filename) && ($output_filename ne "-")) 422{ 423 # Initially create output filename, data is appended 424 # for each data file processed 425 local *DUMMY_HANDLE; 426 open(DUMMY_HANDLE, ">$output_filename") 427 or die("ERROR: cannot create $output_filename!\n"); 428 close(DUMMY_HANDLE); 429 430 # Make $output_filename an absolute path because we're going 431 # to change directories while processing files 432 if (!($output_filename =~ /^\/(.*)$/)) 433 { 434 $output_filename = $cwd."/".$output_filename; 435 } 436} 437 438# Do something 439foreach my $entry (@data_directory) { 440 gen_info($entry); 441} 442 443if ($initial) { 444 warn("Note: --initial does not generate branch coverage ". 445 "data\n"); 446} 447info("Finished .info-file creation\n"); 448 449exit(0); 450 451 452 453# 454# print_usage(handle) 455# 456# Print usage information. 457# 458 459sub print_usage(*) 460{ 461 local *HANDLE = $_[0]; 462 463 print(HANDLE <<END_OF_USAGE); 464Usage: $tool_name [OPTIONS] DIRECTORY 465 466Traverse DIRECTORY and create a .info file for each data file found. Note 467that you may specify more than one directory, all of which are then processed 468sequentially. 469 470 -h, --help Print this help, then exit 471 -v, --version Print version number, then exit 472 -q, --quiet Do not print progress messages 473 -i, --initial Capture initial zero coverage data 474 -t, --test-name NAME Use test case name NAME for resulting data 475 -o, --output-filename OUTFILE Write data only to OUTFILE 476 -f, --follow Follow links when searching .da/.gcda files 477 -b, --base-directory DIR Use DIR as base directory for relative paths 478 --(no-)checksum Enable (disable) line checksumming 479 --(no-)compat-libtool Enable (disable) libtool compatibility mode 480 --gcov-tool TOOL Specify gcov tool location 481 --ignore-errors ERROR Continue after ERROR (gcov, source, graph) 482 --no-recursion Exclude subdirectories from processing 483 --function-coverage Capture function call counts 484 --no-markers Ignore exclusion markers in source code 485 --derive-func-data Generate function data from line data 486 487For more information see: $lcov_url 488END_OF_USAGE 489 ; 490} 491 492# 493# get_common_prefix(min_dir, filenames) 494# 495# Return the longest path prefix shared by all filenames. MIN_DIR specifies 496# the minimum number of directories that a filename may have after removing 497# the prefix. 498# 499 500sub get_common_prefix($@) 501{ 502 my ($min_dir, @files) = @_; 503 my $file; 504 my @prefix; 505 my $i; 506 507 foreach $file (@files) { 508 my ($v, $d, $f) = splitpath($file); 509 my @comp = splitdir($d); 510 511 if (!@prefix) { 512 @prefix = @comp; 513 next; 514 } 515 for ($i = 0; $i < scalar(@comp) && $i < scalar(@prefix); $i++) { 516 if ($comp[$i] ne $prefix[$i] || 517 ((scalar(@comp) - ($i + 1)) <= $min_dir)) { 518 delete(@prefix[$i..scalar(@prefix)]); 519 last; 520 } 521 } 522 } 523 524 return catdir(@prefix); 525} 526 527# 528# gen_info(directory) 529# 530# Traverse DIRECTORY and create a .info file for each data file found. 531# The .info file contains TEST_NAME in the following format: 532# 533# TN:<test name> 534# 535# For each source file name referenced in the data file, there is a section 536# containing source code and coverage data: 537# 538# SF:<absolute path to the source file> 539# FN:<line number of function start>,<function name> for each function 540# DA:<line number>,<execution count> for each instrumented line 541# LH:<number of lines with an execution count> greater than 0 542# LF:<number of instrumented lines> 543# 544# Sections are separated by: 545# 546# end_of_record 547# 548# In addition to the main source code file there are sections for each 549# #included file containing executable code. Note that the absolute path 550# of a source file is generated by interpreting the contents of the respective 551# graph file. Relative filenames are prefixed with the directory in which the 552# graph file is found. Note also that symbolic links to the graph file will be 553# resolved so that the actual file path is used instead of the path to a link. 554# This approach is necessary for the mechanism to work with the /proc/gcov 555# files. 556# 557# Die on error. 558# 559 560sub gen_info($) 561{ 562 my $directory = $_[0]; 563 my @file_list; 564 my $file; 565 my $prefix; 566 my $type; 567 my $ext; 568 569 if ($initial) { 570 $type = "graph"; 571 $ext = $graph_file_extension; 572 } else { 573 $type = "data"; 574 $ext = $data_file_extension; 575 } 576 577 if (-d $directory) 578 { 579 info("Scanning $directory for $ext files ...\n"); 580 581 @file_list = `find "$directory" $maxdepth $follow -name \\*$ext -type f 2>/dev/null`; 582 chomp(@file_list); 583 @file_list or 584 die("ERROR: no $ext files found in $directory!\n"); 585 $prefix = get_common_prefix(1, @file_list); 586 info("Found %d %s files in %s\n", $#file_list+1, $type, 587 $directory); 588 } 589 else 590 { 591 @file_list = ($directory); 592 $prefix = ""; 593 } 594 595 # Process all files in list 596 foreach $file (@file_list) { 597 # Process file 598 if ($initial) { 599 process_graphfile($file, $prefix); 600 } else { 601 process_dafile($file, $prefix); 602 } 603 } 604} 605 606 607sub derive_data($$$) 608{ 609 my ($contentdata, $funcdata, $bbdata) = @_; 610 my @gcov_content = @{$contentdata}; 611 my @gcov_functions = @{$funcdata}; 612 my %fn_count; 613 my %ln_fn; 614 my $line; 615 my $maxline; 616 my %fn_name; 617 my $fn; 618 my $count; 619 620 if (!defined($bbdata)) { 621 return @gcov_functions; 622 } 623 624 # First add existing function data 625 while (@gcov_functions) { 626 $count = shift(@gcov_functions); 627 $fn = shift(@gcov_functions); 628 629 $fn_count{$fn} = $count; 630 } 631 632 # Convert line coverage data to function data 633 foreach $fn (keys(%{$bbdata})) { 634 my $line_data = $bbdata->{$fn}; 635 my $line; 636 637 if ($fn eq "") { 638 next; 639 } 640 # Find the lowest line count for this function 641 $count = 0; 642 foreach $line (@$line_data) { 643 my $lcount = $gcov_content[ ( $line - 1 ) * 3 + 1 ]; 644 645 if (($lcount > 0) && 646 (($count == 0) || ($lcount < $count))) { 647 $count = $lcount; 648 } 649 } 650 $fn_count{$fn} = $count; 651 } 652 653 654 # Check if we got data for all functions 655 foreach $fn (keys(%fn_name)) { 656 if ($fn eq "") { 657 next; 658 } 659 if (defined($fn_count{$fn})) { 660 next; 661 } 662 warn("WARNING: no derived data found for function $fn\n"); 663 } 664 665 # Convert hash to list in @gcov_functions format 666 foreach $fn (sort(keys(%fn_count))) { 667 push(@gcov_functions, $fn_count{$fn}, $fn); 668 } 669 670 return @gcov_functions; 671} 672 673# 674# get_filenames(directory, pattern) 675# 676# Return a list of filenames found in directory which match the specified 677# pattern. 678# 679# Die on error. 680# 681 682sub get_filenames($$) 683{ 684 my ($dirname, $pattern) = @_; 685 my @result; 686 my $directory; 687 local *DIR; 688 689 opendir(DIR, $dirname) or 690 die("ERROR: cannot read directory $dirname\n"); 691 while ($directory = readdir(DIR)) { 692 push(@result, $directory) if ($directory =~ /$pattern/); 693 } 694 closedir(DIR); 695 696 return @result; 697} 698 699# 700# process_dafile(da_filename, dir) 701# 702# Create a .info file for a single data file. 703# 704# Die on error. 705# 706 707sub process_dafile($$) 708{ 709 my ($file, $dir) = @_; 710 my $da_filename; # Name of data file to process 711 my $da_dir; # Directory of data file 712 my $source_dir; # Directory of source file 713 my $da_basename; # data filename without ".da/.gcda" extension 714 my $bb_filename; # Name of respective graph file 715 my $bb_basename; # Basename of the original graph file 716 my $graph; # Contents of graph file 717 my $instr; # Contents of graph file part 2 718 my $gcov_error; # Error code of gcov tool 719 my $object_dir; # Directory containing all object files 720 my $source_filename; # Name of a source code file 721 my $gcov_file; # Name of a .gcov file 722 my @gcov_content; # Content of a .gcov file 723 my $gcov_branches; # Branch content of a .gcov file 724 my @gcov_functions; # Function calls of a .gcov file 725 my @gcov_list; # List of generated .gcov files 726 my $line_number; # Line number count 727 my $lines_hit; # Number of instrumented lines hit 728 my $lines_found; # Number of instrumented lines found 729 my $funcs_hit; # Number of instrumented functions hit 730 my $funcs_found; # Number of instrumented functions found 731 my $br_hit; 732 my $br_found; 733 my $source; # gcov source header information 734 my $object; # gcov object header information 735 my @matches; # List of absolute paths matching filename 736 my @unprocessed; # List of unprocessed source code files 737 my $base_dir; # Base directory for current file 738 my @tmp_links; # Temporary links to be cleaned up 739 my @result; 740 my $index; 741 my $da_renamed; # If data file is to be renamed 742 local *INFO_HANDLE; 743 744 info("Processing %s\n", abs2rel($file, $dir)); 745 # Get path to data file in absolute and normalized form (begins with /, 746 # contains no more ../ or ./) 747 $da_filename = solve_relative_path($cwd, $file); 748 749 # Get directory and basename of data file 750 ($da_dir, $da_basename) = split_filename($da_filename); 751 752 # avoid files from .libs dirs 753 if ($compat_libtool && $da_dir =~ m/(.*)\/\.libs$/) { 754 $source_dir = $1; 755 } else { 756 $source_dir = $da_dir; 757 } 758 759 if (-z $da_filename) 760 { 761 $da_renamed = 1; 762 } 763 else 764 { 765 $da_renamed = 0; 766 } 767 768 # Construct base_dir for current file 769 if ($base_directory) 770 { 771 $base_dir = $base_directory; 772 } 773 else 774 { 775 $base_dir = $source_dir; 776 } 777 778 # Check for writable $base_dir (gcov will try to write files there) 779 stat($base_dir); 780 if (!-w _) 781 { 782 die("ERROR: cannot write to directory $base_dir!\n"); 783 } 784 785 # Construct name of graph file 786 $bb_basename = $da_basename.$graph_file_extension; 787 $bb_filename = "$da_dir/$bb_basename"; 788 789 # Find out the real location of graph file in case we're just looking at 790 # a link 791 while (readlink($bb_filename)) 792 { 793 my $last_dir = dirname($bb_filename); 794 795 $bb_filename = readlink($bb_filename); 796 $bb_filename = solve_relative_path($last_dir, $bb_filename); 797 } 798 799 # Ignore empty graph file (e.g. source file with no statement) 800 if (-z $bb_filename) 801 { 802 warn("WARNING: empty $bb_filename (skipped)\n"); 803 return; 804 } 805 806 # Read contents of graph file into hash. We need it later to find out 807 # the absolute path to each .gcov file created as well as for 808 # information about functions and their source code positions. 809 if ($gcov_version < $GCOV_VERSION_3_4_0) 810 { 811 if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER) 812 { 813 ($instr, $graph) = read_bbg($bb_filename, $base_dir); 814 } 815 else 816 { 817 ($instr, $graph) = read_bb($bb_filename, $base_dir); 818 } 819 } 820 else 821 { 822 ($instr, $graph) = read_gcno($bb_filename, $base_dir); 823 } 824 825 # Set $object_dir to real location of object files. This may differ 826 # from $da_dir if the graph file is just a link to the "real" object 827 # file location. 828 $object_dir = dirname($bb_filename); 829 830 # Is the data file in a different directory? (this happens e.g. with 831 # the gcov-kernel patch) 832 if ($object_dir ne $da_dir) 833 { 834 # Need to create link to data file in $object_dir 835 system("ln", "-s", $da_filename, 836 "$object_dir/$da_basename$data_file_extension") 837 and die ("ERROR: cannot create link $object_dir/". 838 "$da_basename$data_file_extension!\n"); 839 push(@tmp_links, 840 "$object_dir/$da_basename$data_file_extension"); 841 # Need to create link to graph file if basename of link 842 # and file are different (CONFIG_MODVERSION compat) 843 if ((basename($bb_filename) ne $bb_basename) && 844 (! -e "$object_dir/$bb_basename")) { 845 symlink($bb_filename, "$object_dir/$bb_basename") or 846 warn("WARNING: cannot create link ". 847 "$object_dir/$bb_basename\n"); 848 push(@tmp_links, "$object_dir/$bb_basename"); 849 } 850 } 851 852 # Change to directory containing data files and apply GCOV 853 chdir($base_dir); 854 855 if ($da_renamed) 856 { 857 # Need to rename empty data file to workaround 858 # gcov <= 3.2.x bug (Abort) 859 system_no_output(3, "mv", "$da_filename", "$da_filename.ori") 860 and die ("ERROR: cannot rename $da_filename\n"); 861 } 862 863 # Execute gcov command and suppress standard output 864 $gcov_error = system_no_output(1, $gcov_tool, $da_filename, 865 "-o", $object_dir, @gcov_options); 866 867 if ($da_renamed) 868 { 869 system_no_output(3, "mv", "$da_filename.ori", "$da_filename") 870 and die ("ERROR: cannot rename $da_filename.ori"); 871 } 872 873 # Clean up temporary links 874 foreach (@tmp_links) { 875 unlink($_); 876 } 877 878 if ($gcov_error) 879 { 880 if ($ignore[$ERROR_GCOV]) 881 { 882 warn("WARNING: GCOV failed for $da_filename!\n"); 883 return; 884 } 885 die("ERROR: GCOV failed for $da_filename!\n"); 886 } 887 888 # Collect data from resulting .gcov files and create .info file 889 @gcov_list = get_filenames('.', '\.gcov$'); 890 891 # Check for files 892 if (!@gcov_list) 893 { 894 warn("WARNING: gcov did not create any files for ". 895 "$da_filename!\n"); 896 } 897 898 # Check whether we're writing to a single file 899 if ($output_filename) 900 { 901 if ($output_filename eq "-") 902 { 903 *INFO_HANDLE = *STDOUT; 904 } 905 else 906 { 907 # Append to output file 908 open(INFO_HANDLE, ">>$output_filename") 909 or die("ERROR: cannot write to ". 910 "$output_filename!\n"); 911 } 912 } 913 else 914 { 915 # Open .info file for output 916 open(INFO_HANDLE, ">$da_filename.info") 917 or die("ERROR: cannot create $da_filename.info!\n"); 918 } 919 920 # Write test name 921 printf(INFO_HANDLE "TN:%s\n", $test_name); 922 923 # Traverse the list of generated .gcov files and combine them into a 924 # single .info file 925 @unprocessed = keys(%{$instr}); 926 foreach $gcov_file (sort(@gcov_list)) 927 { 928 my $i; 929 my $num; 930 931 ($source, $object) = read_gcov_header($gcov_file); 932 933 if (defined($source)) 934 { 935 $source = solve_relative_path($base_dir, $source); 936 } 937 938 # gcov will happily create output even if there's no source code 939 # available - this interferes with checksum creation so we need 940 # to pull the emergency brake here. 941 if (defined($source) && ! -r $source && $checksum) 942 { 943 if ($ignore[$ERROR_SOURCE]) 944 { 945 warn("WARNING: could not read source file ". 946 "$source\n"); 947 next; 948 } 949 die("ERROR: could not read source file $source\n"); 950 } 951 952 @matches = match_filename(defined($source) ? $source : 953 $gcov_file, keys(%{$instr})); 954 955 # Skip files that are not mentioned in the graph file 956 if (!@matches) 957 { 958 warn("WARNING: cannot find an entry for ".$gcov_file. 959 " in $graph_file_extension file, skipping ". 960 "file!\n"); 961 unlink($gcov_file); 962 next; 963 } 964 965 # Read in contents of gcov file 966 @result = read_gcov_file($gcov_file); 967 if (!defined($result[0])) { 968 warn("WARNING: skipping unreadable file ". 969 $gcov_file."\n"); 970 unlink($gcov_file); 971 next; 972 } 973 @gcov_content = @{$result[0]}; 974 $gcov_branches = $result[1]; 975 @gcov_functions = @{$result[2]}; 976 977 # Skip empty files 978 if (!@gcov_content) 979 { 980 warn("WARNING: skipping empty file ".$gcov_file."\n"); 981 unlink($gcov_file); 982 next; 983 } 984 985 if (scalar(@matches) == 1) 986 { 987 # Just one match 988 $source_filename = $matches[0]; 989 } 990 else 991 { 992 # Try to solve the ambiguity 993 $source_filename = solve_ambiguous_match($gcov_file, 994 \@matches, \@gcov_content); 995 } 996 997 # Remove processed file from list 998 for ($index = scalar(@unprocessed) - 1; $index >= 0; $index--) 999 { 1000 if ($unprocessed[$index] eq $source_filename) 1001 { 1002 splice(@unprocessed, $index, 1); 1003 last; 1004 } 1005 } 1006 1007 # Write absolute path of source file 1008 printf(INFO_HANDLE "SF:%s\n", $source_filename); 1009 1010 # If requested, derive function coverage data from 1011 # line coverage data of the first line of a function 1012 if ($opt_derive_func_data) { 1013 @gcov_functions = 1014 derive_data(\@gcov_content, \@gcov_functions, 1015 $graph->{$source_filename}); 1016 } 1017 1018 # Write function-related information 1019 if (defined($graph->{$source_filename})) 1020 { 1021 my $fn_data = $graph->{$source_filename}; 1022 my $fn; 1023 1024 foreach $fn (sort 1025 {$fn_data->{$a}->[0] <=> $fn_data->{$b}->[0]} 1026 keys(%{$fn_data})) { 1027 my $ln_data = $fn_data->{$fn}; 1028 my $line = $ln_data->[0]; 1029 1030 # Skip empty function 1031 if ($fn eq "") { 1032 next; 1033 } 1034 # Remove excluded functions 1035 if (!$no_markers) { 1036 my $gfn; 1037 my $found = 0; 1038 1039 foreach $gfn (@gcov_functions) { 1040 if ($gfn eq $fn) { 1041 $found = 1; 1042 last; 1043 } 1044 } 1045 if (!$found) { 1046 next; 1047 } 1048 } 1049 1050 # Normalize function name 1051 $fn = filter_fn_name($fn); 1052 1053 print(INFO_HANDLE "FN:$line,$fn\n"); 1054 } 1055 } 1056 1057 #-- 1058 #-- FNDA: <call-count>, <function-name> 1059 #-- FNF: overall count of functions 1060 #-- FNH: overall count of functions with non-zero call count 1061 #-- 1062 $funcs_found = 0; 1063 $funcs_hit = 0; 1064 while (@gcov_functions) 1065 { 1066 my $count = shift(@gcov_functions); 1067 my $fn = shift(@gcov_functions); 1068 1069 $fn = filter_fn_name($fn); 1070 printf(INFO_HANDLE "FNDA:$count,$fn\n"); 1071 $funcs_found++; 1072 $funcs_hit++ if ($count > 0); 1073 } 1074 if ($funcs_found > 0) { 1075 printf(INFO_HANDLE "FNF:%s\n", $funcs_found); 1076 printf(INFO_HANDLE "FNH:%s\n", $funcs_hit); 1077 } 1078 1079 # Write coverage information for each instrumented branch: 1080 # 1081 # BRDA:<line number>,<block number>,<branch number>,<taken> 1082 # 1083 # where 'taken' is the number of times the branch was taken 1084 # or '-' if the block to which the branch belongs was never 1085 # executed 1086 $br_found = 0; 1087 $br_hit = 0; 1088 $num = br_gvec_len($gcov_branches); 1089 for ($i = 0; $i < $num; $i++) { 1090 my ($line, $block, $branch, $taken) = 1091 br_gvec_get($gcov_branches, $i); 1092 1093 print(INFO_HANDLE "BRDA:$line,$block,$branch,$taken\n"); 1094 $br_found++; 1095 $br_hit++ if ($taken ne '-' && $taken > 0); 1096 } 1097 if ($br_found > 0) { 1098 printf(INFO_HANDLE "BRF:%s\n", $br_found); 1099 printf(INFO_HANDLE "BRH:%s\n", $br_hit); 1100 } 1101 1102 # Reset line counters 1103 $line_number = 0; 1104 $lines_found = 0; 1105 $lines_hit = 0; 1106 1107 # Write coverage information for each instrumented line 1108 # Note: @gcov_content contains a list of (flag, count, source) 1109 # tuple for each source code line 1110 while (@gcov_content) 1111 { 1112 $line_number++; 1113 1114 # Check for instrumented line 1115 if ($gcov_content[0]) 1116 { 1117 $lines_found++; 1118 printf(INFO_HANDLE "DA:".$line_number.",". 1119 $gcov_content[1].($checksum ? 1120 ",". md5_base64($gcov_content[2]) : ""). 1121 "\n"); 1122 1123 # Increase $lines_hit in case of an execution 1124 # count>0 1125 if ($gcov_content[1] > 0) { $lines_hit++; } 1126 } 1127 1128 # Remove already processed data from array 1129 splice(@gcov_content,0,3); 1130 } 1131 1132 # Write line statistics and section separator 1133 printf(INFO_HANDLE "LF:%s\n", $lines_found); 1134 printf(INFO_HANDLE "LH:%s\n", $lines_hit); 1135 print(INFO_HANDLE "end_of_record\n"); 1136 1137 # Remove .gcov file after processing 1138 unlink($gcov_file); 1139 } 1140 1141 # Check for files which show up in the graph file but were never 1142 # processed 1143 if (@unprocessed && @gcov_list) 1144 { 1145 foreach (@unprocessed) 1146 { 1147 warn("WARNING: no data found for $_\n"); 1148 } 1149 } 1150 1151 if (!($output_filename && ($output_filename eq "-"))) 1152 { 1153 close(INFO_HANDLE); 1154 } 1155 1156 # Change back to initial directory 1157 chdir($cwd); 1158} 1159 1160 1161# 1162# solve_relative_path(path, dir) 1163# 1164# Solve relative path components of DIR which, if not absolute, resides in PATH. 1165# 1166 1167sub solve_relative_path($$) 1168{ 1169 my $path = $_[0]; 1170 my $dir = $_[1]; 1171 my $result; 1172 1173 $result = $dir; 1174 # Prepend path if not absolute 1175 if ($dir =~ /^[^\/]/) 1176 { 1177 $result = "$path/$result"; 1178 } 1179 1180 # Remove // 1181 $result =~ s/\/\//\//g; 1182 1183 # Remove . 1184 $result =~ s/\/\.\//\//g; 1185 1186 # Solve .. 1187 while ($result =~ s/\/[^\/]+\/\.\.\//\//) 1188 { 1189 } 1190 1191 # Remove preceding .. 1192 $result =~ s/^\/\.\.\//\//g; 1193 1194 return $result; 1195} 1196 1197 1198# 1199# match_filename(gcov_filename, list) 1200# 1201# Return a list of those entries of LIST which match the relative filename 1202# GCOV_FILENAME. 1203# 1204 1205sub match_filename($@) 1206{ 1207 my ($filename, @list) = @_; 1208 my ($vol, $dir, $file) = splitpath($filename); 1209 my @comp = splitdir($dir); 1210 my $comps = scalar(@comp); 1211 my $entry; 1212 my @result; 1213 1214entry: 1215 foreach $entry (@list) { 1216 my ($evol, $edir, $efile) = splitpath($entry); 1217 my @ecomp; 1218 my $ecomps; 1219 my $i; 1220 1221 # Filename component must match 1222 if ($efile ne $file) { 1223 next; 1224 } 1225 # Check directory components last to first for match 1226 @ecomp = splitdir($edir); 1227 $ecomps = scalar(@ecomp); 1228 if ($ecomps < $comps) { 1229 next; 1230 } 1231 for ($i = 0; $i < $comps; $i++) { 1232 if ($comp[$comps - $i - 1] ne 1233 $ecomp[$ecomps - $i - 1]) { 1234 next entry; 1235 } 1236 } 1237 push(@result, $entry), 1238 } 1239 1240 return @result; 1241} 1242 1243# 1244# solve_ambiguous_match(rel_filename, matches_ref, gcov_content_ref) 1245# 1246# Try to solve ambiguous matches of mapping (gcov file) -> (source code) file 1247# by comparing source code provided in the GCOV file with that of the files 1248# in MATCHES. REL_FILENAME identifies the relative filename of the gcov 1249# file. 1250# 1251# Return the one real match or die if there is none. 1252# 1253 1254sub solve_ambiguous_match($$$) 1255{ 1256 my $rel_name = $_[0]; 1257 my $matches = $_[1]; 1258 my $content = $_[2]; 1259 my $filename; 1260 my $index; 1261 my $no_match; 1262 local *SOURCE; 1263 1264 # Check the list of matches 1265 foreach $filename (@$matches) 1266 { 1267 1268 # Compare file contents 1269 open(SOURCE, $filename) 1270 or die("ERROR: cannot read $filename!\n"); 1271 1272 $no_match = 0; 1273 for ($index = 2; <SOURCE>; $index += 3) 1274 { 1275 chomp; 1276 1277 # Also remove CR from line-end 1278 s/\015$//; 1279 1280 if ($_ ne @$content[$index]) 1281 { 1282 $no_match = 1; 1283 last; 1284 } 1285 } 1286 1287 close(SOURCE); 1288 1289 if (!$no_match) 1290 { 1291 info("Solved source file ambiguity for $rel_name\n"); 1292 return $filename; 1293 } 1294 } 1295 1296 die("ERROR: could not match gcov data for $rel_name!\n"); 1297} 1298 1299 1300# 1301# split_filename(filename) 1302# 1303# Return (path, filename, extension) for a given FILENAME. 1304# 1305 1306sub split_filename($) 1307{ 1308 my @path_components = split('/', $_[0]); 1309 my @file_components = split('\.', pop(@path_components)); 1310 my $extension = pop(@file_components); 1311 1312 return (join("/",@path_components), join(".",@file_components), 1313 $extension); 1314} 1315 1316 1317# 1318# read_gcov_header(gcov_filename) 1319# 1320# Parse file GCOV_FILENAME and return a list containing the following 1321# information: 1322# 1323# (source, object) 1324# 1325# where: 1326# 1327# source: complete relative path of the source code file (gcc >= 3.3 only) 1328# object: name of associated graph file 1329# 1330# Die on error. 1331# 1332 1333sub read_gcov_header($) 1334{ 1335 my $source; 1336 my $object; 1337 local *INPUT; 1338 1339 if (!open(INPUT, $_[0])) 1340 { 1341 if ($ignore_errors[$ERROR_GCOV]) 1342 { 1343 warn("WARNING: cannot read $_[0]!\n"); 1344 return (undef,undef); 1345 } 1346 die("ERROR: cannot read $_[0]!\n"); 1347 } 1348 1349 while (<INPUT>) 1350 { 1351 chomp($_); 1352 1353 # Also remove CR from line-end 1354 s/\015$//; 1355 1356 if (/^\s+-:\s+0:Source:(.*)$/) 1357 { 1358 # Source: header entry 1359 $source = $1; 1360 } 1361 elsif (/^\s+-:\s+0:Object:(.*)$/) 1362 { 1363 # Object: header entry 1364 $object = $1; 1365 } 1366 else 1367 { 1368 last; 1369 } 1370 } 1371 1372 close(INPUT); 1373 1374 return ($source, $object); 1375} 1376 1377 1378# 1379# br_gvec_len(vector) 1380# 1381# Return the number of entries in the branch coverage vector. 1382# 1383 1384sub br_gvec_len($) 1385{ 1386 my ($vec) = @_; 1387 1388 return 0 if (!defined($vec)); 1389 return (length($vec) * 8 / $BR_VEC_WIDTH) / $BR_VEC_ENTRIES; 1390} 1391 1392 1393# 1394# br_gvec_get(vector, number) 1395# 1396# Return an entry from the branch coverage vector. 1397# 1398 1399sub br_gvec_get($$) 1400{ 1401 my ($vec, $num) = @_; 1402 my $line; 1403 my $block; 1404 my $branch; 1405 my $taken; 1406 my $offset = $num * $BR_VEC_ENTRIES; 1407 1408 # Retrieve data from vector 1409 $line = vec($vec, $offset + $BR_LINE, $BR_VEC_WIDTH); 1410 $block = vec($vec, $offset + $BR_BLOCK, $BR_VEC_WIDTH); 1411 $branch = vec($vec, $offset + $BR_BRANCH, $BR_VEC_WIDTH); 1412 $taken = vec($vec, $offset + $BR_TAKEN, $BR_VEC_WIDTH); 1413 1414 # Decode taken value from an integer 1415 if ($taken == 0) { 1416 $taken = "-"; 1417 } else { 1418 $taken--; 1419 } 1420 1421 return ($line, $block, $branch, $taken); 1422} 1423 1424 1425# 1426# br_gvec_push(vector, line, block, branch, taken) 1427# 1428# Add an entry to the branch coverage vector. 1429# 1430 1431sub br_gvec_push($$$$$) 1432{ 1433 my ($vec, $line, $block, $branch, $taken) = @_; 1434 my $offset; 1435 1436 $vec = "" if (!defined($vec)); 1437 $offset = br_gvec_len($vec) * $BR_VEC_ENTRIES; 1438 1439 # Encode taken value into an integer 1440 if ($taken eq "-") { 1441 $taken = 0; 1442 } else { 1443 $taken++; 1444 } 1445 1446 # Add to vector 1447 vec($vec, $offset + $BR_LINE, $BR_VEC_WIDTH) = $line; 1448 vec($vec, $offset + $BR_BLOCK, $BR_VEC_WIDTH) = $block; 1449 vec($vec, $offset + $BR_BRANCH, $BR_VEC_WIDTH) = $branch; 1450 vec($vec, $offset + $BR_TAKEN, $BR_VEC_WIDTH) = $taken; 1451 1452 return $vec; 1453} 1454 1455 1456# 1457# read_gcov_file(gcov_filename) 1458# 1459# Parse file GCOV_FILENAME (.gcov file format) and return the list: 1460# (reference to gcov_content, reference to gcov_branch, reference to gcov_func) 1461# 1462# gcov_content is a list of 3 elements 1463# (flag, count, source) for each source code line: 1464# 1465# $result[($line_number-1)*3+0] = instrumentation flag for line $line_number 1466# $result[($line_number-1)*3+1] = execution count for line $line_number 1467# $result[($line_number-1)*3+2] = source code text for line $line_number 1468# 1469# gcov_branch is a vector of 4 4-byte long elements for each branch: 1470# line number, block number, branch number, count + 1 or 0 1471# 1472# gcov_func is a list of 2 elements 1473# (number of calls, function name) for each function 1474# 1475# Die on error. 1476# 1477 1478sub read_gcov_file($) 1479{ 1480 my $filename = $_[0]; 1481 my @result = (); 1482 my $branches = ""; 1483 my @functions = (); 1484 my $number; 1485 my $exclude_flag = 0; 1486 my $exclude_line = 0; 1487 my $last_block = $UNNAMED_BLOCK; 1488 my $last_line = 0; 1489 local *INPUT; 1490 1491 if (!open(INPUT, $filename)) { 1492 if ($ignore_errors[$ERROR_GCOV]) 1493 { 1494 warn("WARNING: cannot read $filename!\n"); 1495 return (undef, undef, undef); 1496 } 1497 die("ERROR: cannot read $filename!\n"); 1498 } 1499 1500 if ($gcov_version < $GCOV_VERSION_3_3_0) 1501 { 1502 # Expect gcov format as used in gcc < 3.3 1503 while (<INPUT>) 1504 { 1505 chomp($_); 1506 1507 # Also remove CR from line-end 1508 s/\015$//; 1509 1510 if (/^branch\s+(\d+)\s+taken\s+=\s+(\d+)/) { 1511 next if ($exclude_line); 1512 $branches = br_gvec_push($branches, $last_line, 1513 $last_block, $1, $2); 1514 } elsif (/^branch\s+(\d+)\s+never\s+executed/) { 1515 next if ($exclude_line); 1516 $branches = br_gvec_push($branches, $last_line, 1517 $last_block, $1, '-'); 1518 } 1519 elsif (/^call/ || /^function/) 1520 { 1521 # Function call return data 1522 } 1523 else 1524 { 1525 $last_line++; 1526 # Check for exclusion markers 1527 if (!$no_markers) { 1528 if (/$EXCL_STOP/) { 1529 $exclude_flag = 0; 1530 } elsif (/$EXCL_START/) { 1531 $exclude_flag = 1; 1532 } 1533 if (/$EXCL_LINE/ || $exclude_flag) { 1534 $exclude_line = 1; 1535 } else { 1536 $exclude_line = 0; 1537 } 1538 } 1539 # Source code execution data 1540 if (/^\t\t(.*)$/) 1541 { 1542 # Uninstrumented line 1543 push(@result, 0); 1544 push(@result, 0); 1545 push(@result, $1); 1546 next; 1547 } 1548 $number = (split(" ",substr($_, 0, 16)))[0]; 1549 1550 # Check for zero count which is indicated 1551 # by ###### 1552 if ($number eq "######") { $number = 0; } 1553 1554 if ($exclude_line) { 1555 # Register uninstrumented line instead 1556 push(@result, 0); 1557 push(@result, 0); 1558 } else { 1559 push(@result, 1); 1560 push(@result, $number); 1561 } 1562 push(@result, substr($_, 16)); 1563 } 1564 } 1565 } 1566 else 1567 { 1568 # Expect gcov format as used in gcc >= 3.3 1569 while (<INPUT>) 1570 { 1571 chomp($_); 1572 1573 # Also remove CR from line-end 1574 s/\015$//; 1575 1576 if (/^\s*(\d+|\$+):\s*(\d+)-block\s+(\d+)\s*$/) { 1577 # Block information - used to group related 1578 # branches 1579 $last_line = $2; 1580 $last_block = $3; 1581 } elsif (/^branch\s+(\d+)\s+taken\s+(\d+)/) { 1582 next if ($exclude_line); 1583 $branches = br_gvec_push($branches, $last_line, 1584 $last_block, $1, $2); 1585 } elsif (/^branch\s+(\d+)\s+never\s+executed/) { 1586 next if ($exclude_line); 1587 $branches = br_gvec_push($branches, $last_line, 1588 $last_block, $1, '-'); 1589 } 1590 elsif (/^function\s+(\S+)\s+called\s+(\d+)/) 1591 { 1592 if ($exclude_line) { 1593 next; 1594 } 1595 push(@functions, $2, $1); 1596 } 1597 elsif (/^call/) 1598 { 1599 # Function call return data 1600 } 1601 elsif (/^\s*([^:]+):\s*([^:]+):(.*)$/) 1602 { 1603 my ($count, $line, $code) = ($1, $2, $3); 1604 1605 $last_line = $line; 1606 $last_block = $UNNAMED_BLOCK; 1607 # Check for exclusion markers 1608 if (!$no_markers) { 1609 if (/$EXCL_STOP/) { 1610 $exclude_flag = 0; 1611 } elsif (/$EXCL_START/) { 1612 $exclude_flag = 1; 1613 } 1614 if (/$EXCL_LINE/ || $exclude_flag) { 1615 $exclude_line = 1; 1616 } else { 1617 $exclude_line = 0; 1618 } 1619 } 1620 # <exec count>:<line number>:<source code> 1621 if ($line eq "0") 1622 { 1623 # Extra data 1624 } 1625 elsif ($count eq "-") 1626 { 1627 # Uninstrumented line 1628 push(@result, 0); 1629 push(@result, 0); 1630 push(@result, $code); 1631 } 1632 else 1633 { 1634 if ($exclude_line) { 1635 push(@result, 0); 1636 push(@result, 0); 1637 } else { 1638 # Check for zero count 1639 if ($count eq "#####") { 1640 $count = 0; 1641 } 1642 push(@result, 1); 1643 push(@result, $count); 1644 } 1645 push(@result, $code); 1646 } 1647 } 1648 } 1649 } 1650 1651 close(INPUT); 1652 if ($exclude_flag) { 1653 warn("WARNING: unterminated exclusion section in $filename\n"); 1654 } 1655 return(\@result, $branches, \@functions); 1656} 1657 1658 1659# 1660# Get the GCOV tool version. Return an integer number which represents the 1661# GCOV version. Version numbers can be compared using standard integer 1662# operations. 1663# 1664 1665sub get_gcov_version() 1666{ 1667 local *HANDLE; 1668 my $version_string; 1669 my $result; 1670 1671 open(GCOV_PIPE, "$gcov_tool -v |") 1672 or die("ERROR: cannot retrieve gcov version!\n"); 1673 $version_string = <GCOV_PIPE>; 1674 close(GCOV_PIPE); 1675 1676 $result = 0; 1677 if ($version_string =~ /(\d+)\.(\d+)(\.(\d+))?/) 1678 { 1679 if (defined($4)) 1680 { 1681 info("Found gcov version: $1.$2.$4\n"); 1682 $result = $1 << 16 | $2 << 8 | $4; 1683 } 1684 else 1685 { 1686 info("Found gcov version: $1.$2\n"); 1687 $result = $1 << 16 | $2 << 8; 1688 } 1689 } 1690 if ($version_string =~ /suse/i && $result == 0x30303 || 1691 $version_string =~ /mandrake/i && $result == 0x30302) 1692 { 1693 info("Using compatibility mode for GCC 3.3 (hammer)\n"); 1694 $compatibility = $COMPAT_HAMMER; 1695 } 1696 return $result; 1697} 1698 1699 1700# 1701# info(printf_parameter) 1702# 1703# Use printf to write PRINTF_PARAMETER to stdout only when the $quiet flag 1704# is not set. 1705# 1706 1707sub info(@) 1708{ 1709 if (!$quiet) 1710 { 1711 # Print info string 1712 if (defined($output_filename) && ($output_filename eq "-")) 1713 { 1714 # Don't interfere with the .info output to STDOUT 1715 printf(STDERR @_); 1716 } 1717 else 1718 { 1719 printf(@_); 1720 } 1721 } 1722} 1723 1724 1725# 1726# int_handler() 1727# 1728# Called when the script was interrupted by an INT signal (e.g. CTRl-C) 1729# 1730 1731sub int_handler() 1732{ 1733 if ($cwd) { chdir($cwd); } 1734 info("Aborted.\n"); 1735 exit(1); 1736} 1737 1738 1739# 1740# system_no_output(mode, parameters) 1741# 1742# Call an external program using PARAMETERS while suppressing depending on 1743# the value of MODE: 1744# 1745# MODE & 1: suppress STDOUT 1746# MODE & 2: suppress STDERR 1747# 1748# Return 0 on success, non-zero otherwise. 1749# 1750 1751sub system_no_output($@) 1752{ 1753 my $mode = shift; 1754 my $result; 1755 local *OLD_STDERR; 1756 local *OLD_STDOUT; 1757 1758 # Save old stdout and stderr handles 1759 ($mode & 1) && open(OLD_STDOUT, ">>&STDOUT"); 1760 ($mode & 2) && open(OLD_STDERR, ">>&STDERR"); 1761 1762 # Redirect to /dev/null 1763 ($mode & 1) && open(STDOUT, ">/dev/null"); 1764 ($mode & 2) && open(STDERR, ">/dev/null"); 1765 1766 system(@_); 1767 $result = $?; 1768 1769 # Close redirected handles 1770 ($mode & 1) && close(STDOUT); 1771 ($mode & 2) && close(STDERR); 1772 1773 # Restore old handles 1774 ($mode & 1) && open(STDOUT, ">>&OLD_STDOUT"); 1775 ($mode & 2) && open(STDERR, ">>&OLD_STDERR"); 1776 1777 return $result; 1778} 1779 1780 1781# 1782# read_config(filename) 1783# 1784# Read configuration file FILENAME and return a reference to a hash containing 1785# all valid key=value pairs found. 1786# 1787 1788sub read_config($) 1789{ 1790 my $filename = $_[0]; 1791 my %result; 1792 my $key; 1793 my $value; 1794 local *HANDLE; 1795 1796 if (!open(HANDLE, "<$filename")) 1797 { 1798 warn("WARNING: cannot read configuration file $filename\n"); 1799 return undef; 1800 } 1801 while (<HANDLE>) 1802 { 1803 chomp; 1804 # Skip comments 1805 s/#.*//; 1806 # Remove leading blanks 1807 s/^\s+//; 1808 # Remove trailing blanks 1809 s/\s+$//; 1810 next unless length; 1811 ($key, $value) = split(/\s*=\s*/, $_, 2); 1812 if (defined($key) && defined($value)) 1813 { 1814 $result{$key} = $value; 1815 } 1816 else 1817 { 1818 warn("WARNING: malformed statement in line $. ". 1819 "of configuration file $filename\n"); 1820 } 1821 } 1822 close(HANDLE); 1823 return \%result; 1824} 1825 1826 1827# 1828# apply_config(REF) 1829# 1830# REF is a reference to a hash containing the following mapping: 1831# 1832# key_string => var_ref 1833# 1834# where KEY_STRING is a keyword and VAR_REF is a reference to an associated 1835# variable. If the global configuration hash CONFIG contains a value for 1836# keyword KEY_STRING, VAR_REF will be assigned the value for that keyword. 1837# 1838 1839sub apply_config($) 1840{ 1841 my $ref = $_[0]; 1842 1843 foreach (keys(%{$ref})) 1844 { 1845 if (defined($config->{$_})) 1846 { 1847 ${$ref->{$_}} = $config->{$_}; 1848 } 1849 } 1850} 1851 1852 1853# 1854# get_exclusion_data(filename) 1855# 1856# Scan specified source code file for exclusion markers and return 1857# linenumber -> 1 1858# for all lines which should be excluded. 1859# 1860 1861sub get_exclusion_data($) 1862{ 1863 my ($filename) = @_; 1864 my %list; 1865 my $flag = 0; 1866 local *HANDLE; 1867 1868 if (!open(HANDLE, "<$filename")) { 1869 warn("WARNING: could not open $filename\n"); 1870 return undef; 1871 } 1872 while (<HANDLE>) { 1873 if (/$EXCL_STOP/) { 1874 $flag = 0; 1875 } elsif (/$EXCL_START/) { 1876 $flag = 1; 1877 } 1878 if (/$EXCL_LINE/ || $flag) { 1879 $list{$.} = 1; 1880 } 1881 } 1882 close(HANDLE); 1883 1884 if ($flag) { 1885 warn("WARNING: unterminated exclusion section in $filename\n"); 1886 } 1887 1888 return \%list; 1889} 1890 1891 1892# 1893# apply_exclusion_data(instr, graph) 1894# 1895# Remove lines from instr and graph data structures which are marked 1896# for exclusion in the source code file. 1897# 1898# Return adjusted (instr, graph). 1899# 1900# graph : file name -> function data 1901# function data : function name -> line data 1902# line data : [ line1, line2, ... ] 1903# 1904# instr : filename -> line data 1905# line data : [ line1, line2, ... ] 1906# 1907 1908sub apply_exclusion_data($$) 1909{ 1910 my ($instr, $graph) = @_; 1911 my $filename; 1912 my %excl_data; 1913 my $excl_read_failed = 0; 1914 1915 # Collect exclusion marker data 1916 foreach $filename (sort_uniq_lex(keys(%{$graph}), keys(%{$instr}))) { 1917 my $excl = get_exclusion_data($filename); 1918 1919 # Skip and note if file could not be read 1920 if (!defined($excl)) { 1921 $excl_read_failed = 1; 1922 next; 1923 } 1924 1925 # Add to collection if there are markers 1926 $excl_data{$filename} = $excl if (keys(%{$excl}) > 0); 1927 } 1928 1929 # Warn if not all source files could be read 1930 if ($excl_read_failed) { 1931 warn("WARNING: some exclusion markers may be ignored\n"); 1932 } 1933 1934 # Skip if no markers were found 1935 return ($instr, $graph) if (keys(%excl_data) == 0); 1936 1937 # Apply exclusion marker data to graph 1938 foreach $filename (keys(%excl_data)) { 1939 my $function_data = $graph->{$filename}; 1940 my $excl = $excl_data{$filename}; 1941 my $function; 1942 1943 next if (!defined($function_data)); 1944 1945 foreach $function (keys(%{$function_data})) { 1946 my $line_data = $function_data->{$function}; 1947 my $line; 1948 my @new_data; 1949 1950 # To be consistent with exclusion parser in non-initial 1951 # case we need to remove a function if the first line 1952 # was excluded 1953 if ($excl->{$line_data->[0]}) { 1954 delete($function_data->{$function}); 1955 next; 1956 } 1957 # Copy only lines which are not excluded 1958 foreach $line (@{$line_data}) { 1959 push(@new_data, $line) if (!$excl->{$line}); 1960 } 1961 1962 # Store modified list 1963 if (scalar(@new_data) > 0) { 1964 $function_data->{$function} = \@new_data; 1965 } else { 1966 # All of this function was excluded 1967 delete($function_data->{$function}); 1968 } 1969 } 1970 1971 # Check if all functions of this file were excluded 1972 if (keys(%{$function_data}) == 0) { 1973 delete($graph->{$filename}); 1974 } 1975 } 1976 1977 # Apply exclusion marker data to instr 1978 foreach $filename (keys(%excl_data)) { 1979 my $line_data = $instr->{$filename}; 1980 my $excl = $excl_data{$filename}; 1981 my $line; 1982 my @new_data; 1983 1984 next if (!defined($line_data)); 1985 1986 # Copy only lines which are not excluded 1987 foreach $line (@{$line_data}) { 1988 push(@new_data, $line) if (!$excl->{$line}); 1989 } 1990 1991 # Store modified list 1992 if (scalar(@new_data) > 0) { 1993 $instr->{$filename} = \@new_data; 1994 } else { 1995 # All of this file was excluded 1996 delete($instr->{$filename}); 1997 } 1998 } 1999 2000 return ($instr, $graph); 2001} 2002 2003 2004sub process_graphfile($$) 2005{ 2006 my ($file, $dir) = @_; 2007 my $graph_filename = $file; 2008 my $graph_dir; 2009 my $graph_basename; 2010 my $source_dir; 2011 my $base_dir; 2012 my $graph; 2013 my $instr; 2014 my $filename; 2015 local *INFO_HANDLE; 2016 2017 info("Processing %s\n", abs2rel($file, $dir)); 2018 2019 # Get path to data file in absolute and normalized form (begins with /, 2020 # contains no more ../ or ./) 2021 $graph_filename = solve_relative_path($cwd, $graph_filename); 2022 2023 # Get directory and basename of data file 2024 ($graph_dir, $graph_basename) = split_filename($graph_filename); 2025 2026 # avoid files from .libs dirs 2027 if ($compat_libtool && $graph_dir =~ m/(.*)\/\.libs$/) { 2028 $source_dir = $1; 2029 } else { 2030 $source_dir = $graph_dir; 2031 } 2032 2033 # Construct base_dir for current file 2034 if ($base_directory) 2035 { 2036 $base_dir = $base_directory; 2037 } 2038 else 2039 { 2040 $base_dir = $source_dir; 2041 } 2042 2043 if ($gcov_version < $GCOV_VERSION_3_4_0) 2044 { 2045 if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER) 2046 { 2047 ($instr, $graph) = read_bbg($graph_filename, $base_dir); 2048 } 2049 else 2050 { 2051 ($instr, $graph) = read_bb($graph_filename, $base_dir); 2052 } 2053 } 2054 else 2055 { 2056 ($instr, $graph) = read_gcno($graph_filename, $base_dir); 2057 } 2058 2059 if (!$no_markers) { 2060 # Apply exclusion marker data to graph file data 2061 ($instr, $graph) = apply_exclusion_data($instr, $graph); 2062 } 2063 2064 # Check whether we're writing to a single file 2065 if ($output_filename) 2066 { 2067 if ($output_filename eq "-") 2068 { 2069 *INFO_HANDLE = *STDOUT; 2070 } 2071 else 2072 { 2073 # Append to output file 2074 open(INFO_HANDLE, ">>$output_filename") 2075 or die("ERROR: cannot write to ". 2076 "$output_filename!\n"); 2077 } 2078 } 2079 else 2080 { 2081 # Open .info file for output 2082 open(INFO_HANDLE, ">$graph_filename.info") 2083 or die("ERROR: cannot create $graph_filename.info!\n"); 2084 } 2085 2086 # Write test name 2087 printf(INFO_HANDLE "TN:%s\n", $test_name); 2088 foreach $filename (sort(keys(%{$instr}))) 2089 { 2090 my $funcdata = $graph->{$filename}; 2091 my $line; 2092 my $linedata; 2093 2094 print(INFO_HANDLE "SF:$filename\n"); 2095 2096 if (defined($funcdata)) { 2097 my @functions = sort {$funcdata->{$a}->[0] <=> 2098 $funcdata->{$b}->[0]} 2099 keys(%{$funcdata}); 2100 my $func; 2101 2102 # Gather list of instrumented lines and functions 2103 foreach $func (@functions) { 2104 $linedata = $funcdata->{$func}; 2105 2106 # Print function name and starting line 2107 print(INFO_HANDLE "FN:".$linedata->[0]. 2108 ",".filter_fn_name($func)."\n"); 2109 } 2110 # Print zero function coverage data 2111 foreach $func (@functions) { 2112 print(INFO_HANDLE "FNDA:0,". 2113 filter_fn_name($func)."\n"); 2114 } 2115 # Print function summary 2116 print(INFO_HANDLE "FNF:".scalar(@functions)."\n"); 2117 print(INFO_HANDLE "FNH:0\n"); 2118 } 2119 # Print zero line coverage data 2120 foreach $line (@{$instr->{$filename}}) { 2121 print(INFO_HANDLE "DA:$line,0\n"); 2122 } 2123 # Print line summary 2124 print(INFO_HANDLE "LF:".scalar(@{$instr->{$filename}})."\n"); 2125 print(INFO_HANDLE "LH:0\n"); 2126 2127 print(INFO_HANDLE "end_of_record\n"); 2128 } 2129 if (!($output_filename && ($output_filename eq "-"))) 2130 { 2131 close(INFO_HANDLE); 2132 } 2133} 2134 2135sub filter_fn_name($) 2136{ 2137 my ($fn) = @_; 2138 2139 # Remove characters used internally as function name delimiters 2140 $fn =~ s/[,=]/_/g; 2141 2142 return $fn; 2143} 2144 2145sub warn_handler($) 2146{ 2147 my ($msg) = @_; 2148 2149 warn("$tool_name: $msg"); 2150} 2151 2152sub die_handler($) 2153{ 2154 my ($msg) = @_; 2155 2156 die("$tool_name: $msg"); 2157} 2158 2159 2160# 2161# graph_error(filename, message) 2162# 2163# Print message about error in graph file. If ignore_graph_error is set, return. 2164# Otherwise abort. 2165# 2166 2167sub graph_error($$) 2168{ 2169 my ($filename, $msg) = @_; 2170 2171 if ($ignore[$ERROR_GRAPH]) { 2172 warn("WARNING: $filename: $msg - skipping\n"); 2173 return; 2174 } 2175 die("ERROR: $filename: $msg\n"); 2176} 2177 2178# 2179# graph_expect(description) 2180# 2181# If debug is set to a non-zero value, print the specified description of what 2182# is expected to be read next from the graph file. 2183# 2184 2185sub graph_expect($) 2186{ 2187 my ($msg) = @_; 2188 2189 if (!$debug || !defined($msg)) { 2190 return; 2191 } 2192 2193 print(STDERR "DEBUG: expecting $msg\n"); 2194} 2195 2196# 2197# graph_read(handle, bytes[, description]) 2198# 2199# Read and return the specified number of bytes from handle. Return undef 2200# if the number of bytes could not be read. 2201# 2202 2203sub graph_read(*$;$) 2204{ 2205 my ($handle, $length, $desc) = @_; 2206 my $data; 2207 my $result; 2208 2209 graph_expect($desc); 2210 $result = read($handle, $data, $length); 2211 if ($debug) { 2212 my $ascii = ""; 2213 my $hex = ""; 2214 my $i; 2215 2216 print(STDERR "DEBUG: read($length)=$result: "); 2217 for ($i = 0; $i < length($data); $i++) { 2218 my $c = substr($data, $i, 1);; 2219 my $n = ord($c); 2220 2221 $hex .= sprintf("%02x ", $n); 2222 if ($n >= 32 && $n <= 127) { 2223 $ascii .= $c; 2224 } else { 2225 $ascii .= "."; 2226 } 2227 } 2228 print(STDERR "$hex |$ascii|"); 2229 print(STDERR "\n"); 2230 } 2231 if ($result != $length) { 2232 return undef; 2233 } 2234 return $data; 2235} 2236 2237# 2238# graph_skip(handle, bytes[, description]) 2239# 2240# Read and discard the specified number of bytes from handle. Return non-zero 2241# if bytes could be read, zero otherwise. 2242# 2243 2244sub graph_skip(*$;$) 2245{ 2246 my ($handle, $length, $desc) = @_; 2247 2248 if (defined(graph_read($handle, $length, $desc))) { 2249 return 1; 2250 } 2251 return 0; 2252} 2253 2254# 2255# sort_uniq(list) 2256# 2257# Return list in numerically ascending order and without duplicate entries. 2258# 2259 2260sub sort_uniq(@) 2261{ 2262 my (@list) = @_; 2263 my %hash; 2264 2265 foreach (@list) { 2266 $hash{$_} = 1; 2267 } 2268 return sort { $a <=> $b } keys(%hash); 2269} 2270 2271# 2272# sort_uniq_lex(list) 2273# 2274# Return list in lexically ascending order and without duplicate entries. 2275# 2276 2277sub sort_uniq_lex(@) 2278{ 2279 my (@list) = @_; 2280 my %hash; 2281 2282 foreach (@list) { 2283 $hash{$_} = 1; 2284 } 2285 return sort keys(%hash); 2286} 2287 2288# 2289# graph_cleanup(graph) 2290# 2291# Remove entries for functions with no lines. Remove duplicate line numbers. 2292# Sort list of line numbers numerically ascending. 2293# 2294 2295sub graph_cleanup($) 2296{ 2297 my ($graph) = @_; 2298 my $filename; 2299 2300 foreach $filename (keys(%{$graph})) { 2301 my $per_file = $graph->{$filename}; 2302 my $function; 2303 2304 foreach $function (keys(%{$per_file})) { 2305 my $lines = $per_file->{$function}; 2306 2307 if (scalar(@$lines) == 0) { 2308 # Remove empty function 2309 delete($per_file->{$function}); 2310 next; 2311 } 2312 # Normalize list 2313 $per_file->{$function} = [ sort_uniq(@$lines) ]; 2314 } 2315 if (scalar(keys(%{$per_file})) == 0) { 2316 # Remove empty file 2317 delete($graph->{$filename}); 2318 } 2319 } 2320} 2321 2322# 2323# graph_find_base(bb) 2324# 2325# Try to identify the filename which is the base source file for the 2326# specified bb data. 2327# 2328 2329sub graph_find_base($) 2330{ 2331 my ($bb) = @_; 2332 my %file_count; 2333 my $basefile; 2334 my $file; 2335 my $func; 2336 my $filedata; 2337 my $count; 2338 my $num; 2339 2340 # Identify base name for this bb data. 2341 foreach $func (keys(%{$bb})) { 2342 $filedata = $bb->{$func}; 2343 2344 foreach $file (keys(%{$filedata})) { 2345 $count = $file_count{$file}; 2346 2347 # Count file occurrence 2348 $file_count{$file} = defined($count) ? $count + 1 : 1; 2349 } 2350 } 2351 $count = 0; 2352 $num = 0; 2353 foreach $file (keys(%file_count)) { 2354 if ($file_count{$file} > $count) { 2355 # The file that contains code for the most functions 2356 # is likely the base file 2357 $count = $file_count{$file}; 2358 $num = 1; 2359 $basefile = $file; 2360 } elsif ($file_count{$file} == $count) { 2361 # If more than one file could be the basefile, we 2362 # don't have a basefile 2363 $basefile = undef; 2364 } 2365 } 2366 2367 return $basefile; 2368} 2369 2370# 2371# graph_from_bb(bb, fileorder, bb_filename) 2372# 2373# Convert data from bb to the graph format and list of instrumented lines. 2374# Returns (instr, graph). 2375# 2376# bb : function name -> file data 2377# : undef -> file order 2378# file data : filename -> line data 2379# line data : [ line1, line2, ... ] 2380# 2381# file order : function name -> [ filename1, filename2, ... ] 2382# 2383# graph : file name -> function data 2384# function data : function name -> line data 2385# line data : [ line1, line2, ... ] 2386# 2387# instr : filename -> line data 2388# line data : [ line1, line2, ... ] 2389# 2390 2391sub graph_from_bb($$$) 2392{ 2393 my ($bb, $fileorder, $bb_filename) = @_; 2394 my $graph = {}; 2395 my $instr = {}; 2396 my $basefile; 2397 my $file; 2398 my $func; 2399 my $filedata; 2400 my $linedata; 2401 my $order; 2402 2403 $basefile = graph_find_base($bb); 2404 # Create graph structure 2405 foreach $func (keys(%{$bb})) { 2406 $filedata = $bb->{$func}; 2407 $order = $fileorder->{$func}; 2408 2409 # Account for lines in functions 2410 if (defined($basefile) && defined($filedata->{$basefile})) { 2411 # If the basefile contributes to this function, 2412 # account this function to the basefile. 2413 $graph->{$basefile}->{$func} = $filedata->{$basefile}; 2414 } else { 2415 # If the basefile does not contribute to this function, 2416 # account this function to the first file contributing 2417 # lines. 2418 $graph->{$order->[0]}->{$func} = 2419 $filedata->{$order->[0]}; 2420 } 2421 2422 foreach $file (keys(%{$filedata})) { 2423 # Account for instrumented lines 2424 $linedata = $filedata->{$file}; 2425 push(@{$instr->{$file}}, @$linedata); 2426 } 2427 } 2428 # Clean up array of instrumented lines 2429 foreach $file (keys(%{$instr})) { 2430 $instr->{$file} = [ sort_uniq(@{$instr->{$file}}) ]; 2431 } 2432 2433 return ($instr, $graph); 2434} 2435 2436# 2437# graph_add_order(fileorder, function, filename) 2438# 2439# Add an entry for filename to the fileorder data set for function. 2440# 2441 2442sub graph_add_order($$$) 2443{ 2444 my ($fileorder, $function, $filename) = @_; 2445 my $item; 2446 my $list; 2447 2448 $list = $fileorder->{$function}; 2449 foreach $item (@$list) { 2450 if ($item eq $filename) { 2451 return; 2452 } 2453 } 2454 push(@$list, $filename); 2455 $fileorder->{$function} = $list; 2456} 2457# 2458# read_bb_word(handle[, description]) 2459# 2460# Read and return a word in .bb format from handle. 2461# 2462 2463sub read_bb_word(*;$) 2464{ 2465 my ($handle, $desc) = @_; 2466 2467 return graph_read($handle, 4, $desc); 2468} 2469 2470# 2471# read_bb_value(handle[, description]) 2472# 2473# Read a word in .bb format from handle and return the word and its integer 2474# value. 2475# 2476 2477sub read_bb_value(*;$) 2478{ 2479 my ($handle, $desc) = @_; 2480 my $word; 2481 2482 $word = read_bb_word($handle, $desc); 2483 return undef if (!defined($word)); 2484 2485 return ($word, unpack("V", $word)); 2486} 2487 2488# 2489# read_bb_string(handle, delimiter) 2490# 2491# Read and return a string in .bb format from handle up to the specified 2492# delimiter value. 2493# 2494 2495sub read_bb_string(*$) 2496{ 2497 my ($handle, $delimiter) = @_; 2498 my $word; 2499 my $value; 2500 my $string = ""; 2501 2502 graph_expect("string"); 2503 do { 2504 ($word, $value) = read_bb_value($handle, "string or delimiter"); 2505 return undef if (!defined($value)); 2506 if ($value != $delimiter) { 2507 $string .= $word; 2508 } 2509 } while ($value != $delimiter); 2510 $string =~ s/\0//g; 2511 2512 return $string; 2513} 2514 2515# 2516# read_bb(filename, base_dir) 2517# 2518# Read the contents of the specified .bb file and return (instr, graph), where: 2519# 2520# instr : filename -> line data 2521# line data : [ line1, line2, ... ] 2522# 2523# graph : filename -> file_data 2524# file_data : function name -> line_data 2525# line_data : [ line1, line2, ... ] 2526# 2527# Relative filenames are converted to absolute form using base_dir as 2528# base directory. See the gcov info pages of gcc 2.95 for a description of 2529# the .bb file format. 2530# 2531 2532sub read_bb($$) 2533{ 2534 my ($bb_filename, $base) = @_; 2535 my $minus_one = 0x80000001; 2536 my $minus_two = 0x80000002; 2537 my $value; 2538 my $filename; 2539 my $function; 2540 my $bb = {}; 2541 my $fileorder = {}; 2542 my $instr; 2543 my $graph; 2544 local *HANDLE; 2545 2546 open(HANDLE, "<$bb_filename") or goto open_error; 2547 binmode(HANDLE); 2548 while (!eof(HANDLE)) { 2549 $value = read_bb_value(*HANDLE, "data word"); 2550 goto incomplete if (!defined($value)); 2551 if ($value == $minus_one) { 2552 # Source file name 2553 graph_expect("filename"); 2554 $filename = read_bb_string(*HANDLE, $minus_one); 2555 goto incomplete if (!defined($filename)); 2556 if ($filename ne "") { 2557 $filename = solve_relative_path($base, 2558 $filename); 2559 } 2560 } elsif ($value == $minus_two) { 2561 # Function name 2562 graph_expect("function name"); 2563 $function = read_bb_string(*HANDLE, $minus_two); 2564 goto incomplete if (!defined($function)); 2565 } elsif ($value > 0) { 2566 # Line number 2567 if (!defined($filename) || !defined($function)) { 2568 warn("WARNING: unassigned line number ". 2569 "$value\n"); 2570 next; 2571 } 2572 push(@{$bb->{$function}->{$filename}}, $value); 2573 graph_add_order($fileorder, $function, $filename); 2574 } 2575 } 2576 close(HANDLE); 2577 ($instr, $graph) = graph_from_bb($bb, $fileorder, $bb_filename); 2578 graph_cleanup($graph); 2579 2580 return ($instr, $graph); 2581 2582open_error: 2583 graph_error($bb_filename, "could not open file"); 2584 return undef; 2585incomplete: 2586 graph_error($bb_filename, "reached unexpected end of file"); 2587 return undef; 2588} 2589 2590# 2591# read_bbg_word(handle[, description]) 2592# 2593# Read and return a word in .bbg format. 2594# 2595 2596sub read_bbg_word(*;$) 2597{ 2598 my ($handle, $desc) = @_; 2599 2600 return graph_read($handle, 4, $desc); 2601} 2602 2603# 2604# read_bbg_value(handle[, description]) 2605# 2606# Read a word in .bbg format from handle and return its integer value. 2607# 2608 2609sub read_bbg_value(*;$) 2610{ 2611 my ($handle, $desc) = @_; 2612 my $word; 2613 2614 $word = read_bbg_word($handle, $desc); 2615 return undef if (!defined($word)); 2616 2617 return unpack("N", $word); 2618} 2619 2620# 2621# read_bbg_string(handle) 2622# 2623# Read and return a string in .bbg format. 2624# 2625 2626sub read_bbg_string(*) 2627{ 2628 my ($handle, $desc) = @_; 2629 my $length; 2630 my $string; 2631 2632 graph_expect("string"); 2633 # Read string length 2634 $length = read_bbg_value($handle, "string length"); 2635 return undef if (!defined($length)); 2636 if ($length == 0) { 2637 return ""; 2638 } 2639 # Read string 2640 $string = graph_read($handle, $length, "string"); 2641 return undef if (!defined($string)); 2642 # Skip padding 2643 graph_skip($handle, 4 - $length % 4, "string padding") or return undef; 2644 2645 return $string; 2646} 2647 2648# 2649# read_bbg_lines_record(handle, bbg_filename, bb, fileorder, filename, 2650# function, base) 2651# 2652# Read a bbg format lines record from handle and add the relevant data to 2653# bb and fileorder. Return filename on success, undef on error. 2654# 2655 2656sub read_bbg_lines_record(*$$$$$$) 2657{ 2658 my ($handle, $bbg_filename, $bb, $fileorder, $filename, $function, 2659 $base) = @_; 2660 my $string; 2661 my $lineno; 2662 2663 graph_expect("lines record"); 2664 # Skip basic block index 2665 graph_skip($handle, 4, "basic block index") or return undef; 2666 while (1) { 2667 # Read line number 2668 $lineno = read_bbg_value($handle, "line number"); 2669 return undef if (!defined($lineno)); 2670 if ($lineno == 0) { 2671 # Got a marker for a new filename 2672 graph_expect("filename"); 2673 $string = read_bbg_string($handle); 2674 return undef if (!defined($string)); 2675 # Check for end of record 2676 if ($string eq "") { 2677 return $filename; 2678 } 2679 $filename = solve_relative_path($base, $string); 2680 next; 2681 } 2682 # Got an actual line number 2683 if (!defined($filename)) { 2684 warn("WARNING: unassigned line number in ". 2685 "$bbg_filename\n"); 2686 next; 2687 } 2688 push(@{$bb->{$function}->{$filename}}, $lineno); 2689 graph_add_order($fileorder, $function, $filename); 2690 } 2691} 2692 2693# 2694# read_bbg(filename, base_dir) 2695# 2696# Read the contents of the specified .bbg file and return the following mapping: 2697# graph: filename -> file_data 2698# file_data: function name -> line_data 2699# line_data: [ line1, line2, ... ] 2700# 2701# Relative filenames are converted to absolute form using base_dir as 2702# base directory. See the gcov-io.h file in the SLES 9 gcc 3.3.3 source code 2703# for a description of the .bbg format. 2704# 2705 2706sub read_bbg($$) 2707{ 2708 my ($bbg_filename, $base) = @_; 2709 my $file_magic = 0x67626267; 2710 my $tag_function = 0x01000000; 2711 my $tag_lines = 0x01450000; 2712 my $word; 2713 my $tag; 2714 my $length; 2715 my $function; 2716 my $filename; 2717 my $bb = {}; 2718 my $fileorder = {}; 2719 my $instr; 2720 my $graph; 2721 local *HANDLE; 2722 2723 open(HANDLE, "<$bbg_filename") or goto open_error; 2724 binmode(HANDLE); 2725 # Read magic 2726 $word = read_bbg_value(*HANDLE, "file magic"); 2727 goto incomplete if (!defined($word)); 2728 # Check magic 2729 if ($word != $file_magic) { 2730 goto magic_error; 2731 } 2732 # Skip version 2733 graph_skip(*HANDLE, 4, "version") or goto incomplete; 2734 while (!eof(HANDLE)) { 2735 # Read record tag 2736 $tag = read_bbg_value(*HANDLE, "record tag"); 2737 goto incomplete if (!defined($tag)); 2738 # Read record length 2739 $length = read_bbg_value(*HANDLE, "record length"); 2740 goto incomplete if (!defined($tag)); 2741 if ($tag == $tag_function) { 2742 graph_expect("function record"); 2743 # Read function name 2744 graph_expect("function name"); 2745 $function = read_bbg_string(*HANDLE); 2746 goto incomplete if (!defined($function)); 2747 $filename = undef; 2748 # Skip function checksum 2749 graph_skip(*HANDLE, 4, "function checksum") 2750 or goto incomplete; 2751 } elsif ($tag == $tag_lines) { 2752 # Read lines record 2753 $filename = read_bbg_lines_record(HANDLE, $bbg_filename, 2754 $bb, $fileorder, $filename, 2755 $function, $base); 2756 goto incomplete if (!defined($filename)); 2757 } else { 2758 # Skip record contents 2759 graph_skip(*HANDLE, $length, "unhandled record") 2760 or goto incomplete; 2761 } 2762 } 2763 close(HANDLE); 2764 ($instr, $graph) = graph_from_bb($bb, $fileorder, $bbg_filename); 2765 graph_cleanup($graph); 2766 2767 return ($instr, $graph); 2768 2769open_error: 2770 graph_error($bbg_filename, "could not open file"); 2771 return undef; 2772incomplete: 2773 graph_error($bbg_filename, "reached unexpected end of file"); 2774 return undef; 2775magic_error: 2776 graph_error($bbg_filename, "found unrecognized bbg file magic"); 2777 return undef; 2778} 2779 2780# 2781# read_gcno_word(handle[, description]) 2782# 2783# Read and return a word in .gcno format. 2784# 2785 2786sub read_gcno_word(*;$) 2787{ 2788 my ($handle, $desc) = @_; 2789 2790 return graph_read($handle, 4, $desc); 2791} 2792 2793# 2794# read_gcno_value(handle, big_endian[, description]) 2795# 2796# Read a word in .gcno format from handle and return its integer value 2797# according to the specified endianness. 2798# 2799 2800sub read_gcno_value(*$;$) 2801{ 2802 my ($handle, $big_endian, $desc) = @_; 2803 my $word; 2804 2805 $word = read_gcno_word($handle, $desc); 2806 return undef if (!defined($word)); 2807 if ($big_endian) { 2808 return unpack("N", $word); 2809 } else { 2810 return unpack("V", $word); 2811 } 2812} 2813 2814# 2815# read_gcno_string(handle, big_endian) 2816# 2817# Read and return a string in .gcno format. 2818# 2819 2820sub read_gcno_string(*$) 2821{ 2822 my ($handle, $big_endian) = @_; 2823 my $length; 2824 my $string; 2825 2826 graph_expect("string"); 2827 # Read string length 2828 $length = read_gcno_value($handle, $big_endian, "string length"); 2829 return undef if (!defined($length)); 2830 if ($length == 0) { 2831 return ""; 2832 } 2833 $length *= 4; 2834 # Read string 2835 $string = graph_read($handle, $length, "string and padding"); 2836 return undef if (!defined($string)); 2837 $string =~ s/\0//g; 2838 2839 return $string; 2840} 2841 2842# 2843# read_gcno_lines_record(handle, gcno_filename, bb, fileorder, filename, 2844# function, base, big_endian) 2845# 2846# Read a gcno format lines record from handle and add the relevant data to 2847# bb and fileorder. Return filename on success, undef on error. 2848# 2849 2850sub read_gcno_lines_record(*$$$$$$$) 2851{ 2852 my ($handle, $gcno_filename, $bb, $fileorder, $filename, $function, 2853 $base, $big_endian) = @_; 2854 my $string; 2855 my $lineno; 2856 2857 graph_expect("lines record"); 2858 # Skip basic block index 2859 graph_skip($handle, 4, "basic block index") or return undef; 2860 while (1) { 2861 # Read line number 2862 $lineno = read_gcno_value($handle, $big_endian, "line number"); 2863 return undef if (!defined($lineno)); 2864 if ($lineno == 0) { 2865 # Got a marker for a new filename 2866 graph_expect("filename"); 2867 $string = read_gcno_string($handle, $big_endian); 2868 return undef if (!defined($string)); 2869 # Check for end of record 2870 if ($string eq "") { 2871 return $filename; 2872 } 2873 $filename = solve_relative_path($base, $string); 2874 next; 2875 } 2876 # Got an actual line number 2877 if (!defined($filename)) { 2878 warn("WARNING: unassigned line number in ". 2879 "$gcno_filename\n"); 2880 next; 2881 } 2882 # Add to list 2883 push(@{$bb->{$function}->{$filename}}, $lineno); 2884 graph_add_order($fileorder, $function, $filename); 2885 } 2886} 2887 2888# 2889# read_gcno_function_record(handle, graph, base, big_endian) 2890# 2891# Read a gcno format function record from handle and add the relevant data 2892# to graph. Return (filename, function) on success, undef on error. 2893# 2894 2895sub read_gcno_function_record(*$$$$) 2896{ 2897 my ($handle, $bb, $fileorder, $base, $big_endian) = @_; 2898 my $filename; 2899 my $function; 2900 my $lineno; 2901 my $lines; 2902 2903 graph_expect("function record"); 2904 # Skip ident and checksum 2905 graph_skip($handle, 8, "function ident and checksum") or return undef; 2906 # Read function name 2907 graph_expect("function name"); 2908 $function = read_gcno_string($handle, $big_endian); 2909 return undef if (!defined($function)); 2910 # Read filename 2911 graph_expect("filename"); 2912 $filename = read_gcno_string($handle, $big_endian); 2913 return undef if (!defined($filename)); 2914 $filename = solve_relative_path($base, $filename); 2915 # Read first line number 2916 $lineno = read_gcno_value($handle, $big_endian, "initial line number"); 2917 return undef if (!defined($lineno)); 2918 # Add to list 2919 push(@{$bb->{$function}->{$filename}}, $lineno); 2920 graph_add_order($fileorder, $function, $filename); 2921 2922 return ($filename, $function); 2923} 2924 2925# 2926# read_gcno(filename, base_dir) 2927# 2928# Read the contents of the specified .gcno file and return the following 2929# mapping: 2930# graph: filename -> file_data 2931# file_data: function name -> line_data 2932# line_data: [ line1, line2, ... ] 2933# 2934# Relative filenames are converted to absolute form using base_dir as 2935# base directory. See the gcov-io.h file in the gcc 3.3 source code 2936# for a description of the .gcno format. 2937# 2938 2939sub read_gcno($$) 2940{ 2941 my ($gcno_filename, $base) = @_; 2942 my $file_magic = 0x67636e6f; 2943 my $tag_function = 0x01000000; 2944 my $tag_lines = 0x01450000; 2945 my $big_endian; 2946 my $word; 2947 my $tag; 2948 my $length; 2949 my $filename; 2950 my $function; 2951 my $bb = {}; 2952 my $fileorder = {}; 2953 my $instr; 2954 my $graph; 2955 local *HANDLE; 2956 2957 open(HANDLE, "<$gcno_filename") or goto open_error; 2958 binmode(HANDLE); 2959 # Read magic 2960 $word = read_gcno_word(*HANDLE, "file magic"); 2961 goto incomplete if (!defined($word)); 2962 # Determine file endianness 2963 if (unpack("N", $word) == $file_magic) { 2964 $big_endian = 1; 2965 } elsif (unpack("V", $word) == $file_magic) { 2966 $big_endian = 0; 2967 } else { 2968 goto magic_error; 2969 } 2970 # Skip version and stamp 2971 graph_skip(*HANDLE, 8, "version and stamp") or goto incomplete; 2972 while (!eof(HANDLE)) { 2973 my $next_pos; 2974 my $curr_pos; 2975 2976 # Read record tag 2977 $tag = read_gcno_value(*HANDLE, $big_endian, "record tag"); 2978 goto incomplete if (!defined($tag)); 2979 # Read record length 2980 $length = read_gcno_value(*HANDLE, $big_endian, 2981 "record length"); 2982 goto incomplete if (!defined($length)); 2983 # Convert length to bytes 2984 $length *= 4; 2985 # Calculate start of next record 2986 $next_pos = tell(HANDLE); 2987 goto tell_error if ($next_pos == -1); 2988 $next_pos += $length; 2989 # Process record 2990 if ($tag == $tag_function) { 2991 ($filename, $function) = read_gcno_function_record( 2992 *HANDLE, $bb, $fileorder, $base, $big_endian); 2993 goto incomplete if (!defined($function)); 2994 } elsif ($tag == $tag_lines) { 2995 # Read lines record 2996 $filename = read_gcno_lines_record(*HANDLE, 2997 $gcno_filename, $bb, $fileorder, 2998 $filename, $function, $base, 2999 $big_endian); 3000 goto incomplete if (!defined($filename)); 3001 } else { 3002 # Skip record contents 3003 graph_skip(*HANDLE, $length, "unhandled record") 3004 or goto incomplete; 3005 } 3006 # Ensure that we are at the start of the next record 3007 $curr_pos = tell(HANDLE); 3008 goto tell_error if ($curr_pos == -1); 3009 next if ($curr_pos == $next_pos); 3010 goto record_error if ($curr_pos > $next_pos); 3011 graph_skip(*HANDLE, $next_pos - $curr_pos, 3012 "unhandled record content") 3013 or goto incomplete; 3014 } 3015 close(HANDLE); 3016 ($instr, $graph) = graph_from_bb($bb, $fileorder, $gcno_filename); 3017 graph_cleanup($graph); 3018 3019 return ($instr, $graph); 3020 3021open_error: 3022 graph_error($gcno_filename, "could not open file"); 3023 return undef; 3024incomplete: 3025 graph_error($gcno_filename, "reached unexpected end of file"); 3026 return undef; 3027magic_error: 3028 graph_error($gcno_filename, "found unrecognized gcno file magic"); 3029 return undef; 3030tell_error: 3031 graph_error($gcno_filename, "could not determine file position"); 3032 return undef; 3033record_error: 3034 graph_error($gcno_filename, "found unrecognized record format"); 3035 return undef; 3036} 3037 3038sub debug($) 3039{ 3040 my ($msg) = @_; 3041 3042 return if (!$debug); 3043 print(STDERR "DEBUG: $msg"); 3044} 3045 3046# 3047# get_gcov_capabilities 3048# 3049# Determine the list of available gcov options. 3050# 3051 3052sub get_gcov_capabilities() 3053{ 3054 my $help = `$gcov_tool --help`; 3055 my %capabilities; 3056 3057 foreach (split(/\n/, $help)) { 3058 next if (!/--(\S+)/); 3059 next if ($1 eq 'help'); 3060 next if ($1 eq 'version'); 3061 next if ($1 eq 'object-directory'); 3062 3063 $capabilities{$1} = 1; 3064 debug("gcov has capability '$1'\n"); 3065 } 3066 3067 return \%capabilities; 3068} 3069