src/third_party/lcov/bin/geninfo

   1 #!/usr/bin/perl -w
   2 #
   3 #   Copyright (c) International Business Machines  Corp., 2002,2012
   4 #
   5 #   This program is free software;  you can redistribute it and/or modify
   6 #   it under the terms of the GNU General Public License as published by
   7 #   the Free Software Foundation; either version 2 of the License, or (at
   8 #   your option) any later version.
   9 #
  10 #   This program is distributed in the hope that it will be useful, but
  11 #   WITHOUT ANY WARRANTY;  without even the implied warranty of
  12 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 #   General Public License for more details.
  14 #
  15 #   You should have received a copy of the GNU General Public License
  16 #   along with this program;  if not, write to the Free Software
  17 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  18 #
  19 #
  20 # geninfo
  21 #
  22 #   This script generates .info files from data files as created by code
  23 #   instrumented with gcc's built-in profiling mechanism. Call it with
  24 #   --help and refer to the geninfo man page to get information on usage
  25 #   and available options.
  26 #
  27 #
  28 # Authors:
  29 #   2002-08-23 created by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com>
  30 #                         IBM Lab Boeblingen
  31 #        based on code by Manoj Iyer <manjo@mail.utexas.edu> and
  32 #                         Megan Bock <mbock@us.ibm.com>
  33 #                         IBM Austin
  34 #   2002-09-05 / Peter Oberparleiter: implemented option that allows file list
  35 #   2003-04-16 / Peter Oberparleiter: modified read_gcov so that it can also
  36 #                parse the new gcov format which is to be introduced in gcc 3.3
  37 #   2003-04-30 / Peter Oberparleiter: made info write to STDERR, not STDOUT
  38 #   2003-07-03 / Peter Oberparleiter: added line checksum support, added
  39 #                --no-checksum
  40 #   2003-09-18 / Nigel Hinds: capture branch coverage data from GCOV
  41 #   2003-12-11 / Laurent Deniel: added --follow option
  42 #                workaround gcov (<= 3.2.x) bug with empty .da files
  43 #   2004-01-03 / Laurent Deniel: Ignore empty .bb files
  44 #   2004-02-16 / Andreas Krebbel: Added support for .gcno/.gcda files and
  45 #                gcov versioning
  46 #   2004-08-09 / Peter Oberparleiter: added configuration file support
  47 #   2008-07-14 / Tom Zoerner: added --function-coverage command line option
  48 #   2008-08-13 / Peter Oberparleiter: modified function coverage
  49 #                implementation (now enabled per default)
  50 #
  51
  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 }