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