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