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