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