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 # lcov 21 # 22 # This is a wrapper script which provides a single interface for accessing 23 # LCOV coverage data. 24 # 25 # 26 # History: 27 # 2002-08-29 created by Peter Oberparleiter <Peter.Oberparleiter (at] de.ibm.com> 28 # IBM Lab Boeblingen 29 # 2002-09-05 / Peter Oberparleiter: implemented --kernel-directory + 30 # multiple directories 31 # 2002-10-16 / Peter Oberparleiter: implemented --add-tracefile option 32 # 2002-10-17 / Peter Oberparleiter: implemented --extract option 33 # 2002-11-04 / Peter Oberparleiter: implemented --list option 34 # 2003-03-07 / Paul Larson: Changed to make it work with the latest gcov 35 # kernel patch. This will break it with older gcov-kernel 36 # patches unless you change the value of $gcovmod in this script 37 # 2003-04-07 / Peter Oberparleiter: fixed bug which resulted in an error 38 # when trying to combine .info files containing data without 39 # a test name 40 # 2003-04-10 / Peter Oberparleiter: extended Paul's change so that LCOV 41 # works both with the new and the old gcov-kernel patch 42 # 2003-04-10 / Peter Oberparleiter: added $gcov_dir constant in anticipation 43 # of a possible move of the gcov kernel directory to another 44 # file system in a future version of the gcov-kernel patch 45 # 2003-04-15 / Paul Larson: make info write to STDERR, not STDOUT 46 # 2003-04-15 / Paul Larson: added --remove option 47 # 2003-04-30 / Peter Oberparleiter: renamed --reset to --zerocounters 48 # to remove naming ambiguity with --remove 49 # 2003-04-30 / Peter Oberparleiter: adjusted help text to include --remove 50 # 2003-06-27 / Peter Oberparleiter: implemented --diff 51 # 2003-07-03 / Peter Oberparleiter: added line checksum support, added 52 # --no-checksum 53 # 2003-12-11 / Laurent Deniel: added --follow option 54 # 2004-03-29 / Peter Oberparleiter: modified --diff option to better cope with 55 # ambiguous patch file entries, modified --capture option to use 56 # modprobe before insmod (needed for 2.6) 57 # 2004-03-30 / Peter Oberparleiter: added --path option 58 # 2004-08-09 / Peter Oberparleiter: added configuration file support 59 # 2008-08-13 / Peter Oberparleiter: added function coverage support 60 # 61 62 use strict; 63 use File::Basename; 64 use File::Path; 65 use File::Find; 66 use File::Temp qw /tempdir/; 67 use File::Spec::Functions qw /abs2rel canonpath catdir catfile catpath 68 file_name_is_absolute rootdir splitdir splitpath/; 69 use Getopt::Long; 70 use Cwd qw /abs_path getcwd/; 71 72 73 # Global constants 74 our $lcov_version = 'LCOV version 1.9'; 75 our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php"; 76 our $tool_name = basename($0); 77 78 # Directory containing gcov kernel files 79 our $gcov_dir; 80 81 # Where to create temporary directories 82 our $tmp_dir; 83 84 # Internal constants 85 our $GKV_PROC = 0; # gcov-kernel data in /proc via external patch 86 our $GKV_SYS = 1; # gcov-kernel data in /sys via vanilla 2.6.31+ 87 our @GKV_NAME = ( "external", "upstream" ); 88 our $pkg_gkv_file = ".gcov_kernel_version"; 89 our $pkg_build_file = ".build_directory"; 90 91 our $BR_BLOCK = 0; 92 our $BR_BRANCH = 1; 93 our $BR_TAKEN = 2; 94 our $BR_VEC_ENTRIES = 3; 95 our $BR_VEC_WIDTH = 32; 96 97 # Branch data combination types 98 our $BR_SUB = 0; 99 our $BR_ADD = 1; 100 101 # Prototypes 102 sub print_usage(*); 103 sub check_options(); 104 sub userspace_reset(); 105 sub userspace_capture(); 106 sub kernel_reset(); 107 sub kernel_capture(); 108 sub kernel_capture_initial(); 109 sub package_capture(); 110 sub add_traces(); 111 sub read_info_file($); 112 sub get_info_entry($); 113 sub set_info_entry($$$$$$$$$;$$$$$$); 114 sub add_counts($$); 115 sub merge_checksums($$$); 116 sub combine_info_entries($$$); 117 sub combine_info_files($$); 118 sub write_info_file(*$); 119 sub extract(); 120 sub remove(); 121 sub list(); 122 sub get_common_filename($$); 123 sub read_diff($); 124 sub diff(); 125 sub system_no_output($@); 126 sub read_config($); 127 sub apply_config($); 128 sub info(@); 129 sub create_temp_dir(); 130 sub transform_pattern($); 131 sub warn_handler($); 132 sub die_handler($); 133 sub abort_handler($); 134 sub temp_cleanup(); 135 sub setup_gkv(); 136 sub get_overall_line($$$$); 137 sub print_overall_rate($$$$$$$$$); 138 sub lcov_geninfo(@); 139 sub create_package($$$;$); 140 sub get_func_found_and_hit($); 141 sub br_ivec_get($$); 142 143 # Global variables & initialization 144 our @directory; # Specifies where to get coverage data from 145 our @kernel_directory; # If set, captures only from specified kernel subdirs 146 our @add_tracefile; # If set, reads in and combines all files in list 147 our $list; # If set, list contents of tracefile 148 our $extract; # If set, extracts parts of tracefile 149 our $remove; # If set, removes parts of tracefile 150 our $diff; # If set, modifies tracefile according to diff 151 our $reset; # If set, reset all coverage data to zero 152 our $capture; # If set, capture data 153 our $output_filename; # Name for file to write coverage data to 154 our $test_name = ""; # Test case name 155 our $quiet = ""; # If set, suppress information messages 156 our $help; # Help option flag 157 our $version; # Version option flag 158 our $convert_filenames; # If set, convert filenames when applying diff 159 our $strip; # If set, strip leading directories when applying diff 160 our $temp_dir_name; # Name of temporary directory 161 our $cwd = `pwd`; # Current working directory 162 our $to_file; # If set, indicates that output is written to a file 163 our $follow; # If set, indicates that find shall follow links 164 our $diff_path = ""; # Path removed from tracefile when applying diff 165 our $base_directory; # Base directory (cwd of gcc during compilation) 166 our $checksum; # If set, calculate a checksum for each line 167 our $no_checksum; # If set, don't calculate a checksum for each line 168 our $compat_libtool; # If set, indicates that libtool mode is to be enabled 169 our $no_compat_libtool; # If set, indicates that libtool mode is to be disabled 170 our $gcov_tool; 171 our $ignore_errors; 172 our $initial; 173 our $no_recursion = 0; 174 our $to_package; 175 our $from_package; 176 our $maxdepth; 177 our $no_markers; 178 our $config; # Configuration file contents 179 chomp($cwd); 180 our $tool_dir = dirname($0); # Directory where genhtml tool is installed 181 our @temp_dirs; 182 our $gcov_gkv; # gcov kernel support version found on machine 183 our $opt_derive_func_data; 184 our $opt_debug; 185 our $opt_list_full_path; 186 our $opt_no_list_full_path; 187 our $opt_list_width = 80; 188 our $opt_list_truncate_max = 20; 189 our $ln_overall_found; 190 our $ln_overall_hit; 191 our $fn_overall_found; 192 our $fn_overall_hit; 193 our $br_overall_found; 194 our $br_overall_hit; 195 196 197 # 198 # Code entry point 199 # 200 201 $SIG{__WARN__} = \&warn_handler; 202 $SIG{__DIE__} = \&die_handler; 203 $SIG{'INT'} = \&abort_handler; 204 $SIG{'QUIT'} = \&abort_handler; 205 206 # Prettify version string 207 $lcov_version =~ s/\$\s*Revision\s*:?\s*(\S+)\s*\$/$1/; 208 209 # Add current working directory if $tool_dir is not already an absolute path 210 if (! ($tool_dir =~ /^\/(.*)$/)) 211 { 212 $tool_dir = "$cwd/$tool_dir"; 213 } 214 215 # Read configuration file if available 216 if (defined($ENV{"HOME"}) && (-r $ENV{"HOME"}."/.lcovrc")) 217 { 218 $config = read_config($ENV{"HOME"}."/.lcovrc"); 219 } 220 elsif (-r "/etc/lcovrc") 221 { 222 $config = read_config("/etc/lcovrc"); 223 } 224 225 if ($config) 226 { 227 # Copy configuration file values to variables 228 apply_config({ 229 "lcov_gcov_dir" => \$gcov_dir, 230 "lcov_tmp_dir" => \$tmp_dir, 231 "lcov_list_full_path" => \$opt_list_full_path, 232 "lcov_list_width" => \$opt_list_width, 233 "lcov_list_truncate_max"=> \$opt_list_truncate_max, 234 }); 235 } 236 237 # Parse command line options 238 if (!GetOptions("directory|d|di=s" => \@directory, 239 "add-tracefile|a=s" => \@add_tracefile, 240 "list|l=s" => \$list, 241 "kernel-directory|k=s" => \@kernel_directory, 242 "extract|e=s" => \$extract, 243 "remove|r=s" => \$remove, 244 "diff=s" => \$diff, 245 "convert-filenames" => \$convert_filenames, 246 "strip=i" => \$strip, 247 "capture|c" => \$capture, 248 "output-file|o=s" => \$output_filename, 249 "test-name|t=s" => \$test_name, 250 "zerocounters|z" => \$reset, 251 "quiet|q" => \$quiet, 252 "help|h|?" => \$help, 253 "version|v" => \$version, 254 "follow|f" => \$follow, 255 "path=s" => \$diff_path, 256 "base-directory|b=s" => \$base_directory, 257 "checksum" => \$checksum, 258 "no-checksum" => \$no_checksum, 259 "compat-libtool" => \$compat_libtool, 260 "no-compat-libtool" => \$no_compat_libtool, 261 "gcov-tool=s" => \$gcov_tool, 262 "ignore-errors=s" => \$ignore_errors, 263 "initial|i" => \$initial, 264 "no-recursion" => \$no_recursion, 265 "to-package=s" => \$to_package, 266 "from-package=s" => \$from_package, 267 "no-markers" => \$no_markers, 268 "derive-func-data" => \$opt_derive_func_data, 269 "debug" => \$opt_debug, 270 "list-full-path" => \$opt_list_full_path, 271 "no-list-full-path" => \$opt_no_list_full_path, 272 )) 273 { 274 print(STDERR "Use $tool_name --help to get usage information\n"); 275 exit(1); 276 } 277 else 278 { 279 # Merge options 280 if (defined($no_checksum)) 281 { 282 $checksum = ($no_checksum ? 0 : 1); 283 $no_checksum = undef; 284 } 285 286 if (defined($no_compat_libtool)) 287 { 288 $compat_libtool = ($no_compat_libtool ? 0 : 1); 289 $no_compat_libtool = undef; 290 } 291 292 if (defined($opt_no_list_full_path)) 293 { 294 $opt_list_full_path = ($opt_no_list_full_path ? 0 : 1); 295 $opt_no_list_full_path = undef; 296 } 297 } 298 299 # Check for help option 300 if ($help) 301 { 302 print_usage(*STDOUT); 303 exit(0); 304 } 305 306 # Check for version option 307 if ($version) 308 { 309 print("$tool_name: $lcov_version\n"); 310 exit(0); 311 } 312 313 # Check list width option 314 if ($opt_list_width <= 40) { 315 die("ERROR: lcov_list_width parameter out of range (needs to be ". 316 "larger than 40)\n"); 317 } 318 319 # Normalize --path text 320 $diff_path =~ s/\/$//; 321 322 if ($follow) 323 { 324 $follow = "-follow"; 325 } 326 else 327 { 328 $follow = ""; 329 } 330 331 if ($no_recursion) 332 { 333 $maxdepth = "-maxdepth 1"; 334 } 335 else 336 { 337 $maxdepth = ""; 338 } 339 340 # Check for valid options 341 check_options(); 342 343 # Only --extract, --remove and --diff allow unnamed parameters 344 if (@ARGV && !($extract || $remove || $diff)) 345 { 346 die("Extra parameter found: '".join(" ", @ARGV)."'\n". 347 "Use $tool_name --help to get usage information\n"); 348 } 349 350 # Check for output filename 351 $to_file = ($output_filename && ($output_filename ne "-")); 352 353 if ($capture) 354 { 355 if (!$to_file) 356 { 357 # Option that tells geninfo to write to stdout 358 $output_filename = "-"; 359 } 360 } 361 362 # Determine kernel directory for gcov data 363 if (!$from_package && !@directory && ($capture || $reset)) { 364 ($gcov_gkv, $gcov_dir) = setup_gkv(); 365 } 366 367 # Check for requested functionality 368 if ($reset) 369 { 370 # Differentiate between user space and kernel reset 371 if (@directory) 372 { 373 userspace_reset(); 374 } 375 else 376 { 377 kernel_reset(); 378 } 379 } 380 elsif ($capture) 381 { 382 # Capture source can be user space, kernel or package 383 if ($from_package) { 384 package_capture(); 385 } elsif (@directory) { 386 userspace_capture(); 387 } else { 388 if ($initial) { 389 if (defined($to_package)) { 390 die("ERROR: --initial cannot be used together ". 391 "with --to-package\n"); 392 } 393 kernel_capture_initial(); 394 } else { 395 kernel_capture(); 396 } 397 } 398 } 399 elsif (@add_tracefile) 400 { 401 ($ln_overall_found, $ln_overall_hit, 402 $fn_overall_found, $fn_overall_hit, 403 $br_overall_found, $br_overall_hit) = add_traces(); 404 } 405 elsif ($remove) 406 { 407 ($ln_overall_found, $ln_overall_hit, 408 $fn_overall_found, $fn_overall_hit, 409 $br_overall_found, $br_overall_hit) = remove(); 410 } 411 elsif ($extract) 412 { 413 ($ln_overall_found, $ln_overall_hit, 414 $fn_overall_found, $fn_overall_hit, 415 $br_overall_found, $br_overall_hit) = extract(); 416 } 417 elsif ($list) 418 { 419 list(); 420 } 421 elsif ($diff) 422 { 423 if (scalar(@ARGV) != 1) 424 { 425 die("ERROR: option --diff requires one additional argument!\n". 426 "Use $tool_name --help to get usage information\n"); 427 } 428 ($ln_overall_found, $ln_overall_hit, 429 $fn_overall_found, $fn_overall_hit, 430 $br_overall_found, $br_overall_hit) = diff(); 431 } 432 433 temp_cleanup(); 434 435 if (defined($ln_overall_found)) { 436 print_overall_rate(1, $ln_overall_found, $ln_overall_hit, 437 1, $fn_overall_found, $fn_overall_hit, 438 1, $br_overall_found, $br_overall_hit); 439 } else { 440 info("Done.\n") if (!$list && !$capture); 441 } 442 exit(0); 443 444 # 445 # print_usage(handle) 446 # 447 # Print usage information. 448 # 449 450 sub print_usage(*) 451 { 452 local *HANDLE = $_[0]; 453 454 print(HANDLE <<END_OF_USAGE); 455 Usage: $tool_name [OPTIONS] 456 457 Use lcov to collect coverage data from either the currently running Linux 458 kernel or from a user space application. Specify the --directory option to 459 get coverage data for a user space program. 460 461 Misc: 462 -h, --help Print this help, then exit 463 -v, --version Print version number, then exit 464 -q, --quiet Do not print progress messages 465 466 Operation: 467 -z, --zerocounters Reset all execution counts to zero 468 -c, --capture Capture coverage data 469 -a, --add-tracefile FILE Add contents of tracefiles 470 -e, --extract FILE PATTERN Extract files matching PATTERN from FILE 471 -r, --remove FILE PATTERN Remove files matching PATTERN from FILE 472 -l, --list FILE List contents of tracefile FILE 473 --diff FILE DIFF Transform tracefile FILE according to DIFF 474 475 Options: 476 -i, --initial Capture initial zero coverage data 477 -t, --test-name NAME Specify test name to be stored with data 478 -o, --output-file FILENAME Write data to FILENAME instead of stdout 479 -d, --directory DIR Use .da files in DIR instead of kernel 480 -f, --follow Follow links when searching .da files 481 -k, --kernel-directory KDIR Capture kernel coverage data only from KDIR 482 -b, --base-directory DIR Use DIR as base directory for relative paths 483 --convert-filenames Convert filenames when applying diff 484 --strip DEPTH Strip initial DEPTH directory levels in diff 485 --path PATH Strip PATH from tracefile when applying diff 486 --(no-)checksum Enable (disable) line checksumming 487 --(no-)compat-libtool Enable (disable) libtool compatibility mode 488 --gcov-tool TOOL Specify gcov tool location 489 --ignore-errors ERRORS Continue after ERRORS (gcov, source, graph) 490 --no-recursion Exclude subdirectories from processing 491 --to-package FILENAME Store unprocessed coverage data in FILENAME 492 --from-package FILENAME Capture from unprocessed data in FILENAME 493 --no-markers Ignore exclusion markers in source code 494 --derive-func-data Generate function data from line data 495 --list-full-path Print full path during a list operation 496 497 For more information see: $lcov_url 498 END_OF_USAGE 499 ; 500 } 501 502 503 # 504 # check_options() 505 # 506 # Check for valid combination of command line options. Die on error. 507 # 508 509 sub check_options() 510 { 511 my $i = 0; 512 513 # Count occurrence of mutually exclusive options 514 $reset && $i++; 515 $capture && $i++; 516 @add_tracefile && $i++; 517 $extract && $i++; 518 $remove && $i++; 519 $list && $i++; 520 $diff && $i++; 521 522 if ($i == 0) 523 { 524 die("Need one of the options -z, -c, -a, -e, -r, -l or ". 525 "--diff\n". 526 "Use $tool_name --help to get usage information\n"); 527 } 528 elsif ($i > 1) 529 { 530 die("ERROR: only one of -z, -c, -a, -e, -r, -l or ". 531 "--diff allowed!\n". 532 "Use $tool_name --help to get usage information\n"); 533 } 534 } 535 536 537 # 538 # userspace_reset() 539 # 540 # Reset coverage data found in DIRECTORY by deleting all contained .da files. 541 # 542 # Die on error. 543 # 544 545 sub userspace_reset() 546 { 547 my $current_dir; 548 my @file_list; 549 550 foreach $current_dir (@directory) 551 { 552 info("Deleting all .da files in $current_dir". 553 ($no_recursion?"\n":" and subdirectories\n")); 554 @file_list = `find "$current_dir" $maxdepth $follow -name \\*\\.da -o -name \\*\\.gcda -type f 2>/dev/null`; 555 chomp(@file_list); 556 foreach (@file_list) 557 { 558 unlink($_) or die("ERROR: cannot remove file $_!\n"); 559 } 560 } 561 } 562 563 564 # 565 # userspace_capture() 566 # 567 # Capture coverage data found in DIRECTORY and write it to a package (if 568 # TO_PACKAGE specified) or to OUTPUT_FILENAME or STDOUT. 569 # 570 # Die on error. 571 # 572 573 sub userspace_capture() 574 { 575 my $dir; 576 my $build; 577 578 if (!defined($to_package)) { 579 lcov_geninfo(@directory); 580 return; 581 } 582 if (scalar(@directory) != 1) { 583 die("ERROR: -d may be specified only once with --to-package\n"); 584 } 585 $dir = $directory[0]; 586 if (defined($base_directory)) { 587 $build = $base_directory; 588 } else { 589 $build = $dir; 590 } 591 create_package($to_package, $dir, $build); 592 } 593 594 595 # 596 # kernel_reset() 597 # 598 # Reset kernel coverage. 599 # 600 # Die on error. 601 # 602 603 sub kernel_reset() 604 { 605 local *HANDLE; 606 my $reset_file; 607 608 info("Resetting kernel execution counters\n"); 609 if (-e "$gcov_dir/vmlinux") { 610 $reset_file = "$gcov_dir/vmlinux"; 611 } elsif (-e "$gcov_dir/reset") { 612 $reset_file = "$gcov_dir/reset"; 613 } else { 614 die("ERROR: no reset control found in $gcov_dir\n"); 615 } 616 open(HANDLE, ">$reset_file") or 617 die("ERROR: cannot write to $reset_file!\n"); 618 print(HANDLE "0"); 619 close(HANDLE); 620 } 621 622 623 # 624 # lcov_copy_single(from, to) 625 # 626 # Copy single regular file FROM to TO without checking its size. This is 627 # required to work with special files generated by the kernel 628 # seq_file-interface. 629 # 630 # 631 sub lcov_copy_single($$) 632 { 633 my ($from, $to) = @_; 634 my $content; 635 local $/; 636 local *HANDLE; 637 638 open(HANDLE, "<$from") or die("ERROR: cannot read $from: $!\n"); 639 $content = <HANDLE>; 640 close(HANDLE); 641 open(HANDLE, ">$to") or die("ERROR: cannot write $from: $!\n"); 642 if (defined($content)) { 643 print(HANDLE $content); 644 } 645 close(HANDLE); 646 } 647 648 # 649 # lcov_find(dir, function, data[, extension, ...)]) 650 # 651 # Search DIR for files and directories whose name matches PATTERN and run 652 # FUNCTION for each match. If not pattern is specified, match all names. 653 # 654 # FUNCTION has the following prototype: 655 # function(dir, relative_name, data) 656 # 657 # Where: 658 # dir: the base directory for this search 659 # relative_name: the name relative to the base directory of this entry 660 # data: the DATA variable passed to lcov_find 661 # 662 sub lcov_find($$$;@) 663 { 664 my ($dir, $fn, $data, @pattern) = @_; 665 my $result; 666 my $_fn = sub { 667 my $filename = $File::Find::name; 668 669 if (defined($result)) { 670 return; 671 } 672 $filename = abs2rel($filename, $dir); 673 foreach (@pattern) { 674 if ($filename =~ /$_/) { 675 goto ok; 676 } 677 } 678 return; 679 ok: 680 $result = &$fn($dir, $filename, $data); 681 }; 682 if (scalar(@pattern) == 0) { 683 @pattern = ".*"; 684 } 685 find( { wanted => $_fn, no_chdir => 1 }, $dir); 686 687 return $result; 688 } 689 690 # 691 # lcov_copy_fn(from, rel, to) 692 # 693 # Copy directories, files and links from/rel to to/rel. 694 # 695 696 sub lcov_copy_fn($$$) 697 { 698 my ($from, $rel, $to) = @_; 699 my $absfrom = canonpath(catfile($from, $rel)); 700 my $absto = canonpath(catfile($to, $rel)); 701 702 if (-d) { 703 if (! -d $absto) { 704 mkpath($absto) or 705 die("ERROR: cannot create directory $absto\n"); 706 chmod(0700, $absto); 707 } 708 } elsif (-l) { 709 # Copy symbolic link 710 my $link = readlink($absfrom); 711 712 if (!defined($link)) { 713 die("ERROR: cannot read link $absfrom: $!\n"); 714 } 715 symlink($link, $absto) or 716 die("ERROR: cannot create link $absto: $!\n"); 717 } else { 718 lcov_copy_single($absfrom, $absto); 719 chmod(0600, $absto); 720 } 721 return undef; 722 } 723 724 # 725 # lcov_copy(from, to, subdirs) 726 # 727 # Copy all specified SUBDIRS and files from directory FROM to directory TO. For 728 # regular files, copy file contents without checking its size. This is required 729 # to work with seq_file-generated files. 730 # 731 732 sub lcov_copy($$;@) 733 { 734 my ($from, $to, @subdirs) = @_; 735 my @pattern; 736 737 foreach (@subdirs) { 738 push(@pattern, "^$_"); 739 } 740 lcov_find($from, \&lcov_copy_fn, $to, @pattern); 741 } 742 743 # 744 # lcov_geninfo(directory) 745 # 746 # Call geninfo for the specified directory and with the parameters specified 747 # at the command line. 748 # 749 750 sub lcov_geninfo(@) 751 { 752 my (@dir) = @_; 753 my @param; 754 755 # Capture data 756 info("Capturing coverage data from ".join(" ", @dir)."\n"); 757 @param = ("$tool_dir/geninfo", @dir); 758 if ($output_filename) 759 { 760 @param = (@param, "--output-filename", $output_filename); 761 } 762 if ($test_name) 763 { 764 @param = (@param, "--test-name", $test_name); 765 } 766 if ($follow) 767 { 768 @param = (@param, "--follow"); 769 } 770 if ($quiet) 771 { 772 @param = (@param, "--quiet"); 773 } 774 if (defined($checksum)) 775 { 776 if ($checksum) 777 { 778 @param = (@param, "--checksum"); 779 } 780 else 781 { 782 @param = (@param, "--no-checksum"); 783 } 784 } 785 if ($base_directory) 786 { 787 @param = (@param, "--base-directory", $base_directory); 788 } 789 if ($no_compat_libtool) 790 { 791 @param = (@param, "--no-compat-libtool"); 792 } 793 elsif ($compat_libtool) 794 { 795 @param = (@param, "--compat-libtool"); 796 } 797 if ($gcov_tool) 798 { 799 @param = (@param, "--gcov-tool", $gcov_tool); 800 } 801 if ($ignore_errors) 802 { 803 @param = (@param, "--ignore-errors", $ignore_errors); 804 } 805 if ($initial) 806 { 807 @param = (@param, "--initial"); 808 } 809 if ($no_markers) 810 { 811 @param = (@param, "--no-markers"); 812 } 813 if ($opt_derive_func_data) 814 { 815 @param = (@param, "--derive-func-data"); 816 } 817 if ($opt_debug) 818 { 819 @param = (@param, "--debug"); 820 } 821 system(@param) and exit($? >> 8); 822 } 823 824 # 825 # read_file(filename) 826 # 827 # Return the contents of the file defined by filename. 828 # 829 830 sub read_file($) 831 { 832 my ($filename) = @_; 833 my $content; 834 local $\; 835 local *HANDLE; 836 837 open(HANDLE, "<$filename") || return undef; 838 $content = <HANDLE>; 839 close(HANDLE); 840 841 return $content; 842 } 843 844 # 845 # get_package(package_file) 846 # 847 # Unpack unprocessed coverage data files from package_file to a temporary 848 # directory and return directory name, build directory and gcov kernel version 849 # as found in package. 850 # 851 852 sub get_package($) 853 { 854 my ($file) = @_; 855 my $dir = create_temp_dir(); 856 my $gkv; 857 my $build; 858 my $cwd = getcwd(); 859 my $count; 860 local *HANDLE; 861 862 info("Reading package $file:\n"); 863 info(" data directory .......: $dir\n"); 864 $file = abs_path($file); 865 chdir($dir); 866 open(HANDLE, "tar xvfz $file 2>/dev/null|") 867 or die("ERROR: could not process package $file\n"); 868 while (<HANDLE>) { 869 if (/\.da$/ || /\.gcda$/) { 870 $count++; 871 } 872 } 873 close(HANDLE); 874 $build = read_file("$dir/$pkg_build_file"); 875 if (defined($build)) { 876 info(" build directory ......: $build\n"); 877 } 878 $gkv = read_file("$dir/$pkg_gkv_file"); 879 if (defined($gkv)) { 880 $gkv = int($gkv); 881 if ($gkv != $GKV_PROC && $gkv != $GKV_SYS) { 882 die("ERROR: unsupported gcov kernel version found ". 883 "($gkv)\n"); 884 } 885 info(" content type .........: kernel data\n"); 886 info(" gcov kernel version ..: %s\n", $GKV_NAME[$gkv]); 887 } else { 888 info(" content type .........: application data\n"); 889 } 890 info(" data files ...........: $count\n"); 891 chdir($cwd); 892 893 return ($dir, $build, $gkv); 894 } 895 896 # 897 # write_file(filename, $content) 898 # 899 # Create a file named filename and write the specified content to it. 900 # 901 902 sub write_file($$) 903 { 904 my ($filename, $content) = @_; 905 local *HANDLE; 906 907 open(HANDLE, ">$filename") || return 0; 908 print(HANDLE $content); 909 close(HANDLE) || return 0; 910 911 return 1; 912 } 913 914 # count_package_data(filename) 915 # 916 # Count the number of coverage data files in the specified package file. 917 # 918 919 sub count_package_data($) 920 { 921 my ($filename) = @_; 922 local *HANDLE; 923 my $count = 0; 924 925 open(HANDLE, "tar tfz $filename|") or return undef; 926 while (<HANDLE>) { 927 if (/\.da$/ || /\.gcda$/) { 928 $count++; 929 } 930 } 931 close(HANDLE); 932 return $count; 933 } 934 935 # 936 # create_package(package_file, source_directory, build_directory[, 937 # kernel_gcov_version]) 938 # 939 # Store unprocessed coverage data files from source_directory to package_file. 940 # 941 942 sub create_package($$$;$) 943 { 944 my ($file, $dir, $build, $gkv) = @_; 945 my $cwd = getcwd(); 946 947 # Print information about the package 948 info("Creating package $file:\n"); 949 info(" data directory .......: $dir\n"); 950 951 # Handle build directory 952 if (defined($build)) { 953 info(" build directory ......: $build\n"); 954 write_file("$dir/$pkg_build_file", $build) 955 or die("ERROR: could not write to ". 956 "$dir/$pkg_build_file\n"); 957 } 958 959 # Handle gcov kernel version data 960 if (defined($gkv)) { 961 info(" content type .........: kernel data\n"); 962 info(" gcov kernel version ..: %s\n", $GKV_NAME[$gkv]); 963 write_file("$dir/$pkg_gkv_file", $gkv) 964 or die("ERROR: could not write to ". 965 "$dir/$pkg_gkv_file\n"); 966 } else { 967 info(" content type .........: application data\n"); 968 } 969 970 # Create package 971 $file = abs_path($file); 972 chdir($dir); 973 system("tar cfz $file .") 974 and die("ERROR: could not create package $file\n"); 975 976 # Remove temporary files 977 unlink("$dir/$pkg_build_file"); 978 unlink("$dir/$pkg_gkv_file"); 979 980 # Show number of data files 981 if (!$quiet) { 982 my $count = count_package_data($file); 983 984 if (defined($count)) { 985 info(" data files ...........: $count\n"); 986 } 987 } 988 chdir($cwd); 989 } 990 991 sub find_link_fn($$$) 992 { 993 my ($from, $rel, $filename) = @_; 994 my $absfile = catfile($from, $rel, $filename); 995 996 if (-l $absfile) { 997 return $absfile; 998 } 999 return undef; 1000 } 1001 1002 # 1003 # get_base(dir) 1004 # 1005 # Return (BASE, OBJ), where 1006 # - BASE: is the path to the kernel base directory relative to dir 1007 # - OBJ: is the absolute path to the kernel build directory 1008 # 1009 1010 sub get_base($) 1011 { 1012 my ($dir) = @_; 1013 my $marker = "kernel/gcov/base.gcno"; 1014 my $markerfile; 1015 my $sys; 1016 my $obj; 1017 my $link; 1018 1019 $markerfile = lcov_find($dir, \&find_link_fn, $marker); 1020 if (!defined($markerfile)) { 1021 return (undef, undef); 1022 } 1023 1024 # sys base is parent of parent of markerfile. 1025 $sys = abs2rel(dirname(dirname(dirname($markerfile))), $dir); 1026 1027 # obj base is parent of parent of markerfile link target. 1028 $link = readlink($markerfile); 1029 if (!defined($link)) { 1030 die("ERROR: could not read $markerfile\n"); 1031 } 1032 $obj = dirname(dirname(dirname($link))); 1033 1034 return ($sys, $obj); 1035 } 1036 1037 # 1038 # apply_base_dir(data_dir, base_dir, build_dir, @directories) 1039 # 1040 # Make entries in @directories relative to data_dir. 1041 # 1042 1043 sub apply_base_dir($$$@) 1044 { 1045 my ($data, $base, $build, @dirs) = @_; 1046 my $dir; 1047 my @result; 1048 1049 foreach $dir (@dirs) { 1050 # Is directory path relative to data directory? 1051 if (-d catdir($data, $dir)) { 1052 push(@result, $dir); 1053 next; 1054 } 1055 # Relative to the auto-detected base-directory? 1056 if (defined($base)) { 1057 if (-d catdir($data, $base, $dir)) { 1058 push(@result, catdir($base, $dir)); 1059 next; 1060 } 1061 } 1062 # Relative to the specified base-directory? 1063 if (defined($base_directory)) { 1064 if (file_name_is_absolute($base_directory)) { 1065 $base = abs2rel($base_directory, rootdir()); 1066 } else { 1067 $base = $base_directory; 1068 } 1069 if (-d catdir($data, $base, $dir)) { 1070 push(@result, catdir($base, $dir)); 1071 next; 1072 } 1073 } 1074 # Relative to the build directory? 1075 if (defined($build)) { 1076 if (file_name_is_absolute($build)) { 1077 $base = abs2rel($build, rootdir()); 1078 } else { 1079 $base = $build; 1080 } 1081 if (-d catdir($data, $base, $dir)) { 1082 push(@result, catdir($base, $dir)); 1083 next; 1084 } 1085 } 1086 die("ERROR: subdirectory $dir not found\n". 1087 "Please use -b to specify the correct directory\n"); 1088 } 1089 return @result; 1090 } 1091 1092 # 1093 # copy_gcov_dir(dir, [@subdirectories]) 1094 # 1095 # Create a temporary directory and copy all or, if specified, only some 1096 # subdirectories from dir to that directory. Return the name of the temporary 1097 # directory. 1098 # 1099 1100 sub copy_gcov_dir($;@) 1101 { 1102 my ($data, @dirs) = @_; 1103 my $tempdir = create_temp_dir(); 1104 1105 info("Copying data to temporary directory $tempdir\n"); 1106 lcov_copy($data, $tempdir, @dirs); 1107 1108 return $tempdir; 1109 } 1110 1111 # 1112 # kernel_capture_initial 1113 # 1114 # Capture initial kernel coverage data, i.e. create a coverage data file from 1115 # static graph files which contains zero coverage data for all instrumented 1116 # lines. 1117 # 1118 1119 sub kernel_capture_initial() 1120 { 1121 my $build; 1122 my $source; 1123 my @params; 1124 1125 if (defined($base_directory)) { 1126 $build = $base_directory; 1127 $source = "specified"; 1128 } else { 1129 (undef, $build) = get_base($gcov_dir); 1130 if (!defined($build)) { 1131 die("ERROR: could not auto-detect build directory.\n". 1132 "Please use -b to specify the build directory\n"); 1133 } 1134 $source = "auto-detected"; 1135 } 1136 info("Using $build as kernel build directory ($source)\n"); 1137 # Build directory needs to be passed to geninfo 1138 $base_directory = $build; 1139 if (@kernel_directory) { 1140 foreach my $dir (@kernel_directory) { 1141 push(@params, "$build/$dir"); 1142 } 1143 } else { 1144 push(@params, $build); 1145 } 1146 lcov_geninfo(@params); 1147 } 1148 1149 # 1150 # kernel_capture_from_dir(directory, gcov_kernel_version, build) 1151 # 1152 # Perform the actual kernel coverage capturing from the specified directory 1153 # assuming that the data was copied from the specified gcov kernel version. 1154 # 1155 1156 sub kernel_capture_from_dir($$$) 1157 { 1158 my ($dir, $gkv, $build) = @_; 1159 1160 # Create package or coverage file 1161 if (defined($to_package)) { 1162 create_package($to_package, $dir, $build, $gkv); 1163 } else { 1164 # Build directory needs to be passed to geninfo 1165 $base_directory = $build; 1166 lcov_geninfo($dir); 1167 } 1168 } 1169 1170 # 1171 # adjust_kernel_dir(dir, build) 1172 # 1173 # Adjust directories specified with -k so that they point to the directory 1174 # relative to DIR. Return the build directory if specified or the auto- 1175 # detected build-directory. 1176 # 1177 1178 sub adjust_kernel_dir($$) 1179 { 1180 my ($dir, $build) = @_; 1181 my ($sys_base, $build_auto) = get_base($dir); 1182 1183 if (!defined($build)) { 1184 $build = $build_auto; 1185 } 1186 if (!defined($build)) { 1187 die("ERROR: could not auto-detect build directory.\n". 1188 "Please use -b to specify the build directory\n"); 1189 } 1190 # Make @kernel_directory relative to sysfs base 1191 if (@kernel_directory) { 1192 @kernel_directory = apply_base_dir($dir, $sys_base, $build, 1193 @kernel_directory); 1194 } 1195 return $build; 1196 } 1197 1198 sub kernel_capture() 1199 { 1200 my $data_dir; 1201 my $build = $base_directory; 1202 1203 if ($gcov_gkv == $GKV_SYS) { 1204 $build = adjust_kernel_dir($gcov_dir, $build); 1205 } 1206 $data_dir = copy_gcov_dir($gcov_dir, @kernel_directory); 1207 kernel_capture_from_dir($data_dir, $gcov_gkv, $build); 1208 } 1209 1210 # 1211 # package_capture() 1212 # 1213 # Capture coverage data from a package of unprocessed coverage data files 1214 # as generated by lcov --to-package. 1215 # 1216 1217 sub package_capture() 1218 { 1219 my $dir; 1220 my $build; 1221 my $gkv; 1222 1223 ($dir, $build, $gkv) = get_package($from_package); 1224 1225 # Check for build directory 1226 if (defined($base_directory)) { 1227 if (defined($build)) { 1228 info("Using build directory specified by -b.\n"); 1229 } 1230 $build = $base_directory; 1231 } 1232 1233 # Do the actual capture 1234 if (defined($gkv)) { 1235 if ($gkv == $GKV_SYS) { 1236 $build = adjust_kernel_dir($dir, $build); 1237 } 1238 if (@kernel_directory) { 1239 $dir = copy_gcov_dir($dir, @kernel_directory); 1240 } 1241 kernel_capture_from_dir($dir, $gkv, $build); 1242 } else { 1243 # Build directory needs to be passed to geninfo 1244 $base_directory = $build; 1245 lcov_geninfo($dir); 1246 } 1247 } 1248 1249 1250 # 1251 # info(printf_parameter) 1252 # 1253 # Use printf to write PRINTF_PARAMETER to stdout only when the $quiet flag 1254 # is not set. 1255 # 1256 1257 sub info(@) 1258 { 1259 if (!$quiet) 1260 { 1261 # Print info string 1262 if ($to_file) 1263 { 1264 printf(@_) 1265 } 1266 else 1267 { 1268 # Don't interfere with the .info output to STDOUT 1269 printf(STDERR @_); 1270 } 1271 } 1272 } 1273 1274 1275 # 1276 # create_temp_dir() 1277 # 1278 # Create a temporary directory and return its path. 1279 # 1280 # Die on error. 1281 # 1282 1283 sub create_temp_dir() 1284 { 1285 my $dir; 1286 1287 if (defined($tmp_dir)) { 1288 $dir = tempdir(DIR => $tmp_dir, CLEANUP => 1); 1289 } else { 1290 $dir = tempdir(CLEANUP => 1); 1291 } 1292 if (!defined($dir)) { 1293 die("ERROR: cannot create temporary directory\n"); 1294 } 1295 push(@temp_dirs, $dir); 1296 1297 return $dir; 1298 } 1299 1300 1301 # 1302 # br_taken_to_num(taken) 1303 # 1304 # Convert a branch taken value .info format to number format. 1305 # 1306 1307 sub br_taken_to_num($) 1308 { 1309 my ($taken) = @_; 1310 1311 return 0 if ($taken eq '-'); 1312 return $taken + 1; 1313 } 1314 1315 1316 # 1317 # br_num_to_taken(taken) 1318 # 1319 # Convert a branch taken value in number format to .info format. 1320 # 1321 1322 sub br_num_to_taken($) 1323 { 1324 my ($taken) = @_; 1325 1326 return '-' if ($taken == 0); 1327 return $taken - 1; 1328 } 1329 1330 1331 # 1332 # br_taken_add(taken1, taken2) 1333 # 1334 # Return the result of taken1 + taken2 for 'branch taken' values. 1335 # 1336 1337 sub br_taken_add($$) 1338 { 1339 my ($t1, $t2) = @_; 1340 1341 return $t1 if (!defined($t2)); 1342 return $t2 if (!defined($t1)); 1343 return $t1 if ($t2 eq '-'); 1344 return $t2 if ($t1 eq '-'); 1345 return $t1 + $t2; 1346 } 1347 1348 1349 # 1350 # br_taken_sub(taken1, taken2) 1351 # 1352 # Return the result of taken1 - taken2 for 'branch taken' values. Return 0 1353 # if the result would become negative. 1354 # 1355 1356 sub br_taken_sub($$) 1357 { 1358 my ($t1, $t2) = @_; 1359 1360 return $t1 if (!defined($t2)); 1361 return undef if (!defined($t1)); 1362 return $t1 if ($t1 eq '-'); 1363 return $t1 if ($t2 eq '-'); 1364 return 0 if $t2 > $t1; 1365 return $t1 - $t2; 1366 } 1367 1368 1369 # 1370 # 1371 # br_ivec_len(vector) 1372 # 1373 # Return the number of entries in the branch coverage vector. 1374 # 1375 1376 sub br_ivec_len($) 1377 { 1378 my ($vec) = @_; 1379 1380 return 0 if (!defined($vec)); 1381 return (length($vec) * 8 / $BR_VEC_WIDTH) / $BR_VEC_ENTRIES; 1382 } 1383 1384 1385 # 1386 # br_ivec_push(vector, block, branch, taken) 1387 # 1388 # Add an entry to the branch coverage vector. If an entry with the same 1389 # branch ID already exists, add the corresponding taken values. 1390 # 1391 1392 sub br_ivec_push($$$$) 1393 { 1394 my ($vec, $block, $branch, $taken) = @_; 1395 my $offset; 1396 my $num = br_ivec_len($vec); 1397 my $i; 1398 1399 $vec = "" if (!defined($vec)); 1400 1401 # Check if branch already exists in vector 1402 for ($i = 0; $i < $num; $i++) { 1403 my ($v_block, $v_branch, $v_taken) = br_ivec_get($vec, $i); 1404 1405 next if ($v_block != $block || $v_branch != $branch); 1406 1407 # Add taken counts 1408 $taken = br_taken_add($taken, $v_taken); 1409 last; 1410 } 1411 1412 $offset = $i * $BR_VEC_ENTRIES; 1413 $taken = br_taken_to_num($taken); 1414 1415 # Add to vector 1416 vec($vec, $offset + $BR_BLOCK, $BR_VEC_WIDTH) = $block; 1417 vec($vec, $offset + $BR_BRANCH, $BR_VEC_WIDTH) = $branch; 1418 vec($vec, $offset + $BR_TAKEN, $BR_VEC_WIDTH) = $taken; 1419 1420 return $vec; 1421 } 1422 1423 1424 # 1425 # br_ivec_get(vector, number) 1426 # 1427 # Return an entry from the branch coverage vector. 1428 # 1429 1430 sub br_ivec_get($$) 1431 { 1432 my ($vec, $num) = @_; 1433 my $block; 1434 my $branch; 1435 my $taken; 1436 my $offset = $num * $BR_VEC_ENTRIES; 1437 1438 # Retrieve data from vector 1439 $block = vec($vec, $offset + $BR_BLOCK, $BR_VEC_WIDTH); 1440 $branch = vec($vec, $offset + $BR_BRANCH, $BR_VEC_WIDTH); 1441 $taken = vec($vec, $offset + $BR_TAKEN, $BR_VEC_WIDTH); 1442 1443 # Decode taken value from an integer 1444 $taken = br_num_to_taken($taken); 1445 1446 return ($block, $branch, $taken); 1447 } 1448 1449 1450 # 1451 # get_br_found_and_hit(brcount) 1452 # 1453 # Return (br_found, br_hit) for brcount 1454 # 1455 1456 sub get_br_found_and_hit($) 1457 { 1458 my ($brcount) = @_; 1459 my $line; 1460 my $br_found = 0; 1461 my $br_hit = 0; 1462 1463 foreach $line (keys(%{$brcount})) { 1464 my $brdata = $brcount->{$line}; 1465 my $i; 1466 my $num = br_ivec_len($brdata); 1467 1468 for ($i = 0; $i < $num; $i++) { 1469 my $taken; 1470 1471 (undef, undef, $taken) = br_ivec_get($brdata, $i); 1472 1473 $br_found++; 1474 $br_hit++ if ($taken ne "-" && $taken > 0); 1475 } 1476 } 1477 1478 return ($br_found, $br_hit); 1479 } 1480 1481 1482 # 1483 # read_info_file(info_filename) 1484 # 1485 # Read in the contents of the .info file specified by INFO_FILENAME. Data will 1486 # be returned as a reference to a hash containing the following mappings: 1487 # 1488 # %result: for each filename found in file -> \%data 1489 # 1490 # %data: "test" -> \%testdata 1491 # "sum" -> \%sumcount 1492 # "func" -> \%funcdata 1493 # "found" -> $lines_found (number of instrumented lines found in file) 1494 # "hit" -> $lines_hit (number of executed lines in file) 1495 # "check" -> \%checkdata 1496 # "testfnc" -> \%testfncdata 1497 # "sumfnc" -> \%sumfnccount 1498 # "testbr" -> \%testbrdata 1499 # "sumbr" -> \%sumbrcount 1500 # 1501 # %testdata : name of test affecting this file -> \%testcount 1502 # %testfncdata: name of test affecting this file -> \%testfnccount 1503 # %testbrdata: name of test affecting this file -> \%testbrcount 1504 # 1505 # %testcount : line number -> execution count for a single test 1506 # %testfnccount: function name -> execution count for a single test 1507 # %testbrcount : line number -> branch coverage data for a single test 1508 # %sumcount : line number -> execution count for all tests 1509 # %sumfnccount : function name -> execution count for all tests 1510 # %sumbrcount : line number -> branch coverage data for all tests 1511 # %funcdata : function name -> line number 1512 # %checkdata : line number -> checksum of source code line 1513 # $brdata : vector of items: block, branch, taken 1514 # 1515 # Note that .info file sections referring to the same file and test name 1516 # will automatically be combined by adding all execution counts. 1517 # 1518 # Note that if INFO_FILENAME ends with ".gz", it is assumed that the file 1519 # is compressed using GZIP. If available, GUNZIP will be used to decompress 1520 # this file. 1521 # 1522 # Die on error. 1523 # 1524 1525 sub read_info_file($) 1526 { 1527 my $tracefile = $_[0]; # Name of tracefile 1528 my %result; # Resulting hash: file -> data 1529 my $data; # Data handle for current entry 1530 my $testdata; # " " 1531 my $testcount; # " " 1532 my $sumcount; # " " 1533 my $funcdata; # " " 1534 my $checkdata; # " " 1535 my $testfncdata; 1536 my $testfnccount; 1537 my $sumfnccount; 1538 my $testbrdata; 1539 my $testbrcount; 1540 my $sumbrcount; 1541 my $line; # Current line read from .info file 1542 my $testname; # Current test name 1543 my $filename; # Current filename 1544 my $hitcount; # Count for lines hit 1545 my $count; # Execution count of current line 1546 my $negative; # If set, warn about negative counts 1547 my $changed_testname; # If set, warn about changed testname 1548 my $line_checksum; # Checksum of current line 1549 local *INFO_HANDLE; # Filehandle for .info file 1550 1551 info("Reading tracefile $tracefile\n"); 1552 1553 # Check if file exists and is readable 1554 stat($_[0]); 1555 if (!(-r _)) 1556 { 1557 die("ERROR: cannot read file $_[0]!\n"); 1558 } 1559 1560 # Check if this is really a plain file 1561 if (!(-f _)) 1562 { 1563 die("ERROR: not a plain file: $_[0]!\n"); 1564 } 1565 1566 # Check for .gz extension 1567 if ($_[0] =~ /\.gz$/) 1568 { 1569 # Check for availability of GZIP tool 1570 system_no_output(1, "gunzip" ,"-h") 1571 and die("ERROR: gunzip command not available!\n"); 1572 1573 # Check integrity of compressed file 1574 system_no_output(1, "gunzip", "-t", $_[0]) 1575 and die("ERROR: integrity check failed for ". 1576 "compressed file $_[0]!\n"); 1577 1578 # Open compressed file 1579 open(INFO_HANDLE, "gunzip -c $_[0]|") 1580 or die("ERROR: cannot start gunzip to decompress ". 1581 "file $_[0]!\n"); 1582 } 1583 else 1584 { 1585 # Open decompressed file 1586 open(INFO_HANDLE, $_[0]) 1587 or die("ERROR: cannot read file $_[0]!\n"); 1588 } 1589 1590 $testname = ""; 1591 while (<INFO_HANDLE>) 1592 { 1593 chomp($_); 1594 $line = $_; 1595 1596 # Switch statement 1597 foreach ($line) 1598 { 1599 /^TN:([^,]*)(,diff)?/ && do 1600 { 1601 # Test name information found 1602 $testname = defined($1) ? $1 : ""; 1603 if ($testname =~ s/\W/_/g) 1604 { 1605 $changed_testname = 1; 1606 } 1607 $testname .= $2 if (defined($2)); 1608 last; 1609 }; 1610 1611 /^[SK]F:(.*)/ && do 1612 { 1613 # Filename information found 1614 # Retrieve data for new entry 1615 $filename = $1; 1616 1617 $data = $result{$filename}; 1618 ($testdata, $sumcount, $funcdata, $checkdata, 1619 $testfncdata, $sumfnccount, $testbrdata, 1620 $sumbrcount) = 1621 get_info_entry($data); 1622 1623 if (defined($testname)) 1624 { 1625 $testcount = $testdata->{$testname}; 1626 $testfnccount = $testfncdata->{$testname}; 1627 $testbrcount = $testbrdata->{$testname}; 1628 } 1629 else 1630 { 1631 $testcount = {}; 1632 $testfnccount = {}; 1633 $testbrcount = {}; 1634 } 1635 last; 1636 }; 1637 1638 /^DA:(\d+),(-?\d+)(,[^,\s]+)?/ && do 1639 { 1640 # Fix negative counts 1641 $count = $2 < 0 ? 0 : $2; 1642 if ($2 < 0) 1643 { 1644 $negative = 1; 1645 } 1646 # Execution count found, add to structure 1647 # Add summary counts 1648 $sumcount->{$1} += $count; 1649 1650 # Add test-specific counts 1651 if (defined($testname)) 1652 { 1653 $testcount->{$1} += $count; 1654 } 1655 1656 # Store line checksum if available 1657 if (defined($3)) 1658 { 1659 $line_checksum = substr($3, 1); 1660 1661 # Does it match a previous definition 1662 if (defined($checkdata->{$1}) && 1663 ($checkdata->{$1} ne 1664 $line_checksum)) 1665 { 1666 die("ERROR: checksum mismatch ". 1667 "at $filename:$1\n"); 1668 } 1669 1670 $checkdata->{$1} = $line_checksum; 1671 } 1672 last; 1673 }; 1674 1675 /^FN:(\d+),([^,]+)/ && do 1676 { 1677 # Function data found, add to structure 1678 $funcdata->{$2} = $1; 1679 1680 # Also initialize function call data 1681 if (!defined($sumfnccount->{$2})) { 1682 $sumfnccount->{$2} = 0; 1683 } 1684 if (defined($testname)) 1685 { 1686 if (!defined($testfnccount->{$2})) { 1687 $testfnccount->{$2} = 0; 1688 } 1689 } 1690 last; 1691 }; 1692 1693 /^FNDA:(\d+),([^,]+)/ && do 1694 { 1695 # Function call count found, add to structure 1696 # Add summary counts 1697 $sumfnccount->{$2} += $1; 1698 1699 # Add test-specific counts 1700 if (defined($testname)) 1701 { 1702 $testfnccount->{$2} += $1; 1703 } 1704 last; 1705 }; 1706 1707 /^BRDA:(\d+),(\d+),(\d+),(\d+|-)/ && do { 1708 # Branch coverage data found 1709 my ($line, $block, $branch, $taken) = 1710 ($1, $2, $3, $4); 1711 1712 $sumbrcount->{$line} = 1713 br_ivec_push($sumbrcount->{$line}, 1714 $block, $branch, $taken); 1715 1716 # Add test-specific counts 1717 if (defined($testname)) { 1718 $testbrcount->{$line} = 1719 br_ivec_push( 1720 $testbrcount->{$line}, 1721 $block, $branch, 1722 $taken); 1723 } 1724 last; 1725 }; 1726 1727 /^end_of_record/ && do 1728 { 1729 # Found end of section marker 1730 if ($filename) 1731 { 1732 # Store current section data 1733 if (defined($testname)) 1734 { 1735 $testdata->{$testname} = 1736 $testcount; 1737 $testfncdata->{$testname} = 1738 $testfnccount; 1739 $testbrdata->{$testname} = 1740 $testbrcount; 1741 } 1742 1743 set_info_entry($data, $testdata, 1744 $sumcount, $funcdata, 1745 $checkdata, $testfncdata, 1746 $sumfnccount, 1747 $testbrdata, 1748 $sumbrcount); 1749 $result{$filename} = $data; 1750 last; 1751 } 1752 }; 1753 1754 # default 1755 last; 1756 } 1757 } 1758 close(INFO_HANDLE); 1759 1760 # Calculate hit and found values for lines and functions of each file 1761 foreach $filename (keys(%result)) 1762 { 1763 $data = $result{$filename}; 1764 1765 ($testdata, $sumcount, undef, undef, $testfncdata, 1766 $sumfnccount, $testbrdata, $sumbrcount) = 1767 get_info_entry($data); 1768 1769 # Filter out empty files 1770 if (scalar(keys(%{$sumcount})) == 0) 1771 { 1772 delete($result{$filename}); 1773 next; 1774 } 1775 # Filter out empty test cases 1776 foreach $testname (keys(%{$testdata})) 1777 { 1778 if (!defined($testdata->{$testname}) || 1779 scalar(keys(%{$testdata->{$testname}})) == 0) 1780 { 1781 delete($testdata->{$testname}); 1782 delete($testfncdata->{$testname}); 1783 } 1784 } 1785 1786 $data->{"found"} = scalar(keys(%{$sumcount})); 1787 $hitcount = 0; 1788 1789 foreach (keys(%{$sumcount})) 1790 { 1791 if ($sumcount->{$_} > 0) { $hitcount++; } 1792 } 1793 1794 $data->{"hit"} = $hitcount; 1795 1796 # Get found/hit values for function call data 1797 $data->{"f_found"} = scalar(keys(%{$sumfnccount})); 1798 $hitcount = 0; 1799 1800 foreach (keys(%{$sumfnccount})) { 1801 if ($sumfnccount->{$_} > 0) { 1802 $hitcount++; 1803 } 1804 } 1805 $data->{"f_hit"} = $hitcount; 1806 1807 # Get found/hit values for branch data 1808 { 1809 my ($br_found, $br_hit) = get_br_found_and_hit($sumbrcount); 1810 1811 $data->{"b_found"} = $br_found; 1812 $data->{"b_hit"} = $br_hit; 1813 } 1814 } 1815 1816 if (scalar(keys(%result)) == 0) 1817 { 1818 die("ERROR: no valid records found in tracefile $tracefile\n"); 1819 } 1820 if ($negative) 1821 { 1822 warn("WARNING: negative counts found in tracefile ". 1823 "$tracefile\n"); 1824 } 1825 if ($changed_testname) 1826 { 1827 warn("WARNING: invalid characters removed from testname in ". 1828 "tracefile $tracefile\n"); 1829 } 1830 1831 return(\%result); 1832 } 1833 1834 1835 # 1836 # get_info_entry(hash_ref) 1837 # 1838 # Retrieve data from an entry of the structure generated by read_info_file(). 1839 # Return a list of references to hashes: 1840 # (test data hash ref, sum count hash ref, funcdata hash ref, checkdata hash 1841 # ref, testfncdata hash ref, sumfnccount hash ref, testbrdata hash ref, 1842 # sumbrcount hash ref, lines found, lines hit, functions found, 1843 # functions hit, branches found, branches hit) 1844 # 1845 1846 sub get_info_entry($) 1847 { 1848 my $testdata_ref = $_[0]->{"test"}; 1849 my $sumcount_ref = $_[0]->{"sum"}; 1850 my $funcdata_ref = $_[0]->{"func"}; 1851 my $checkdata_ref = $_[0]->{"check"}; 1852 my $testfncdata = $_[0]->{"testfnc"}; 1853 my $sumfnccount = $_[0]->{"sumfnc"}; 1854 my $testbrdata = $_[0]->{"testbr"}; 1855 my $sumbrcount = $_[0]->{"sumbr"}; 1856 my $lines_found = $_[0]->{"found"}; 1857 my $lines_hit = $_[0]->{"hit"}; 1858 my $f_found = $_[0]->{"f_found"}; 1859 my $f_hit = $_[0]->{"f_hit"}; 1860 my $br_found = $_[0]->{"b_found"}; 1861 my $br_hit = $_[0]->{"b_hit"}; 1862 1863 return ($testdata_ref, $sumcount_ref, $funcdata_ref, $checkdata_ref, 1864 $testfncdata, $sumfnccount, $testbrdata, $sumbrcount, 1865 $lines_found, $lines_hit, $f_found, $f_hit, 1866 $br_found, $br_hit); 1867 } 1868 1869 1870 # 1871 # set_info_entry(hash_ref, testdata_ref, sumcount_ref, funcdata_ref, 1872 # checkdata_ref, testfncdata_ref, sumfcncount_ref, 1873 # testbrdata_ref, sumbrcount_ref[,lines_found, 1874 # lines_hit, f_found, f_hit, $b_found, $b_hit]) 1875 # 1876 # Update the hash referenced by HASH_REF with the provided data references. 1877 # 1878 1879 sub set_info_entry($$$$$$$$$;$$$$$$) 1880 { 1881 my $data_ref = $_[0]; 1882 1883 $data_ref->{"test"} = $_[1]; 1884 $data_ref->{"sum"} = $_[2]; 1885 $data_ref->{"func"} = $_[3]; 1886 $data_ref->{"check"} = $_[4]; 1887 $data_ref->{"testfnc"} = $_[5]; 1888 $data_ref->{"sumfnc"} = $_[6]; 1889 $data_ref->{"testbr"} = $_[7]; 1890 $data_ref->{"sumbr"} = $_[8]; 1891 1892 if (defined($_[9])) { $data_ref->{"found"} = $_[9]; } 1893 if (defined($_[10])) { $data_ref->{"hit"} = $_[10]; } 1894 if (defined($_[11])) { $data_ref->{"f_found"} = $_[11]; } 1895 if (defined($_[12])) { $data_ref->{"f_hit"} = $_[12]; } 1896 if (defined($_[13])) { $data_ref->{"b_found"} = $_[13]; } 1897 if (defined($_[14])) { $data_ref->{"b_hit"} = $_[14]; } 1898 } 1899 1900 1901 # 1902 # add_counts(data1_ref, data2_ref) 1903 # 1904 # DATA1_REF and DATA2_REF are references to hashes containing a mapping 1905 # 1906 # line number -> execution count 1907 # 1908 # Return a list (RESULT_REF, LINES_FOUND, LINES_HIT) where RESULT_REF 1909 # is a reference to a hash containing the combined mapping in which 1910 # execution counts are added. 1911 # 1912 1913 sub add_counts($$) 1914 { 1915 my %data1 = %{$_[0]}; # Hash 1 1916 my %data2 = %{$_[1]}; # Hash 2 1917 my %result; # Resulting hash 1918 my $line; # Current line iteration scalar 1919 my $data1_count; # Count of line in hash1 1920 my $data2_count; # Count of line in hash2 1921 my $found = 0; # Total number of lines found 1922 my $hit = 0; # Number of lines with a count > 0 1923 1924 foreach $line (keys(%data1)) 1925 { 1926 $data1_count = $data1{$line}; 1927 $data2_count = $data2{$line}; 1928 1929 # Add counts if present in both hashes 1930 if (defined($data2_count)) { $data1_count += $data2_count; } 1931 1932 # Store sum in %result 1933 $result{$line} = $data1_count; 1934 1935 $found++; 1936 if ($data1_count > 0) { $hit++; } 1937 } 1938 1939 # Add lines unique to data2 1940 foreach $line (keys(%data2)) 1941 { 1942 # Skip lines already in data1 1943 if (defined($data1{$line})) { next; } 1944 1945 # Copy count from data2 1946 $result{$line} = $data2{$line}; 1947 1948 $found++; 1949 if ($result{$line} > 0) { $hit++; } 1950 } 1951 1952 return (\%result, $found, $hit); 1953 } 1954 1955 1956 # 1957 # merge_checksums(ref1, ref2, filename) 1958 # 1959 # REF1 and REF2 are references to hashes containing a mapping 1960 # 1961 # line number -> checksum 1962 # 1963 # Merge checksum lists defined in REF1 and REF2 and return reference to 1964 # resulting hash. Die if a checksum for a line is defined in both hashes 1965 # but does not match. 1966 # 1967 1968 sub merge_checksums($$$) 1969 { 1970 my $ref1 = $_[0]; 1971 my $ref2 = $_[1]; 1972 my $filename = $_[2]; 1973 my %result; 1974 my $line; 1975 1976 foreach $line (keys(%{$ref1})) 1977 { 1978 if (defined($ref2->{$line}) && 1979 ($ref1->{$line} ne $ref2->{$line})) 1980 { 1981 die("ERROR: checksum mismatch at $filename:$line\n"); 1982 } 1983 $result{$line} = $ref1->{$line}; 1984 } 1985 1986 foreach $line (keys(%{$ref2})) 1987 { 1988 $result{$line} = $ref2->{$line}; 1989 } 1990 1991 return \%result; 1992 } 1993 1994 1995 # 1996 # merge_func_data(funcdata1, funcdata2, filename) 1997 # 1998 1999 sub merge_func_data($$$) 2000 { 2001 my ($funcdata1, $funcdata2, $filename) = @_; 2002 my %result; 2003 my $func; 2004 2005 if (defined($funcdata1)) { 2006 %result = %{$funcdata1}; 2007 } 2008 2009 foreach $func (keys(%{$funcdata2})) { 2010 my $line1 = $result{$func}; 2011 my $line2 = $funcdata2->{$func}; 2012 2013 if (defined($line1) && ($line1 != $line2)) { 2014 warn("WARNING: function data mismatch at ". 2015 "$filename:$line2\n"); 2016 next; 2017 } 2018 $result{$func} = $line2; 2019 } 2020 2021 return \%result; 2022 } 2023 2024 2025 # 2026 # add_fnccount(fnccount1, fnccount2) 2027 # 2028 # Add function call count data. Return list (fnccount_added, f_found, f_hit) 2029 # 2030 2031 sub add_fnccount($$) 2032 { 2033 my ($fnccount1, $fnccount2) = @_; 2034 my %result; 2035 my $f_found; 2036 my $f_hit; 2037 my $function; 2038 2039 if (defined($fnccount1)) { 2040 %result = %{$fnccount1}; 2041 } 2042 foreach $function (keys(%{$fnccount2})) { 2043 $result{$function} += $fnccount2->{$function}; 2044 } 2045 $f_found = scalar(keys(%result)); 2046 $f_hit = 0; 2047 foreach $function (keys(%result)) { 2048 if ($result{$function} > 0) { 2049 $f_hit++; 2050 } 2051 } 2052 2053 return (\%result, $f_found, $f_hit); 2054 } 2055 2056 # 2057 # add_testfncdata(testfncdata1, testfncdata2) 2058 # 2059 # Add function call count data for several tests. Return reference to 2060 # added_testfncdata. 2061 # 2062 2063 sub add_testfncdata($$) 2064 { 2065 my ($testfncdata1, $testfncdata2) = @_; 2066 my %result; 2067 my $testname; 2068 2069 foreach $testname (keys(%{$testfncdata1})) { 2070 if (defined($testfncdata2->{$testname})) { 2071 my $fnccount; 2072 2073 # Function call count data for this testname exists 2074 # in both data sets: merge 2075 ($fnccount) = add_fnccount( 2076 $testfncdata1->{$testname}, 2077 $testfncdata2->{$testname}); 2078 $result{$testname} = $fnccount; 2079 next; 2080 } 2081 # Function call count data for this testname is unique to 2082 # data set 1: copy 2083 $result{$testname} = $testfncdata1->{$testname}; 2084 } 2085 2086 # Add count data for testnames unique to data set 2 2087 foreach $testname (keys(%{$testfncdata2})) { 2088 if (!defined($result{$testname})) { 2089 $result{$testname} = $testfncdata2->{$testname}; 2090 } 2091 } 2092 return \%result; 2093 } 2094 2095 2096 # 2097 # brcount_to_db(brcount) 2098 # 2099 # Convert brcount data to the following format: 2100 # 2101 # db: line number -> block hash 2102 # block hash: block number -> branch hash 2103 # branch hash: branch number -> taken value 2104 # 2105 2106 sub brcount_to_db($) 2107 { 2108 my ($brcount) = @_; 2109 my $line; 2110 my $db; 2111 2112 # Add branches from first count to database 2113 foreach $line (keys(%{$brcount})) { 2114 my $brdata = $brcount->{$line}; 2115 my $i; 2116 my $num = br_ivec_len($brdata); 2117 2118 for ($i = 0; $i < $num; $i++) { 2119 my ($block, $branch, $taken) = br_ivec_get($brdata, $i); 2120 2121 $db->{$line}->{$block}->{$branch} = $taken; 2122 } 2123 } 2124 2125 return $db; 2126 } 2127 2128 2129 # 2130 # db_to_brcount(db) 2131 # 2132 # Convert branch coverage data back to brcount format. 2133 # 2134 2135 sub db_to_brcount($) 2136 { 2137 my ($db) = @_; 2138 my $line; 2139 my $brcount = {}; 2140 my $br_found = 0; 2141 my $br_hit = 0; 2142 2143 # Convert database back to brcount format 2144 foreach $line (sort({$a <=> $b} keys(%{$db}))) { 2145 my $ldata = $db->{$line}; 2146 my $brdata; 2147 my $block; 2148 2149 foreach $block (sort({$a <=> $b} keys(%{$ldata}))) { 2150 my $bdata = $ldata->{$block}; 2151 my $branch; 2152 2153 foreach $branch (sort({$a <=> $b} keys(%{$bdata}))) { 2154 my $taken = $bdata->{$branch}; 2155 2156 $br_found++; 2157 $br_hit++ if ($taken ne "-" && $taken > 0); 2158 $brdata = br_ivec_push($brdata, $block, 2159 $branch, $taken); 2160 } 2161 } 2162 $brcount->{$line} = $brdata; 2163 } 2164 2165 return ($brcount, $br_found, $br_hit); 2166 } 2167 2168 2169 # combine_brcount(brcount1, brcount2, type) 2170 # 2171 # If add is BR_ADD, add branch coverage data and return list (brcount_added, 2172 # br_found, br_hit). If add is BR_SUB, subtract the taken values of brcount2 2173 # from brcount1 and return (brcount_sub, br_found, br_hit). 2174 # 2175 2176 sub combine_brcount($$$) 2177 { 2178 my ($brcount1, $brcount2, $type) = @_; 2179 my $line; 2180 my $block; 2181 my $branch; 2182 my $taken; 2183 my $db; 2184 my $br_found = 0; 2185 my $br_hit = 0; 2186 my $result; 2187 2188 # Convert branches from first count to database 2189 $db = brcount_to_db($brcount1); 2190 # Combine values from database and second count 2191 foreach $line (keys(%{$brcount2})) { 2192 my $brdata = $brcount2->{$line}; 2193 my $num = br_ivec_len($brdata); 2194 my $i; 2195 2196 for ($i = 0; $i < $num; $i++) { 2197 ($block, $branch, $taken) = br_ivec_get($brdata, $i); 2198 my $new_taken = $db->{$line}->{$block}->{$branch}; 2199 2200 if ($type == $BR_ADD) { 2201 $new_taken = br_taken_add($new_taken, $taken); 2202 } elsif ($type == $BR_SUB) { 2203 $new_taken = br_taken_sub($new_taken, $taken); 2204 } 2205 $db->{$line}->{$block}->{$branch} = $new_taken 2206 if (defined($new_taken)); 2207 } 2208 } 2209 # Convert database back to brcount format 2210 ($result, $br_found, $br_hit) = db_to_brcount($db); 2211 2212 return ($result, $br_found, $br_hit); 2213 } 2214 2215 2216 # 2217 # add_testbrdata(testbrdata1, testbrdata2) 2218 # 2219 # Add branch coverage data for several tests. Return reference to 2220 # added_testbrdata. 2221 # 2222 2223 sub add_testbrdata($$) 2224 { 2225 my ($testbrdata1, $testbrdata2) = @_; 2226 my %result; 2227 my $testname; 2228 2229 foreach $testname (keys(%{$testbrdata1})) { 2230 if (defined($testbrdata2->{$testname})) { 2231 my $brcount; 2232 2233 # Branch coverage data for this testname exists 2234 # in both data sets: add 2235 ($brcount) = combine_brcount( 2236 $testbrdata1->{$testname}, 2237 $testbrdata2->{$testname}, $BR_ADD); 2238 $result{$testname} = $brcount; 2239 next; 2240 } 2241 # Branch coverage data for this testname is unique to 2242 # data set 1: copy 2243 $result{$testname} = $testbrdata1->{$testname}; 2244 } 2245 2246 # Add count data for testnames unique to data set 2 2247 foreach $testname (keys(%{$testbrdata2})) { 2248 if (!defined($result{$testname})) { 2249 $result{$testname} = $testbrdata2->{$testname}; 2250 } 2251 } 2252 return \%result; 2253 } 2254 2255 2256 # 2257 # combine_info_entries(entry_ref1, entry_ref2, filename) 2258 # 2259 # Combine .info data entry hashes referenced by ENTRY_REF1 and ENTRY_REF2. 2260 # Return reference to resulting hash. 2261 # 2262 2263 sub combine_info_entries($$$) 2264 { 2265 my $entry1 = $_[0]; # Reference to hash containing first entry 2266 my $testdata1; 2267 my $sumcount1; 2268 my $funcdata1; 2269 my $checkdata1; 2270 my $testfncdata1; 2271 my $sumfnccount1; 2272 my $testbrdata1; 2273 my $sumbrcount1; 2274 2275 my $entry2 = $_[1]; # Reference to hash containing second entry 2276 my $testdata2; 2277 my $sumcount2; 2278 my $funcdata2; 2279 my $checkdata2; 2280 my $testfncdata2; 2281 my $sumfnccount2; 2282 my $testbrdata2; 2283 my $sumbrcount2; 2284 2285 my %result; # Hash containing combined entry 2286 my %result_testdata; 2287 my $result_sumcount = {}; 2288 my $result_funcdata; 2289 my $result_testfncdata; 2290 my $result_sumfnccount; 2291 my $result_testbrdata; 2292 my $result_sumbrcount; 2293 my $lines_found; 2294 my $lines_hit; 2295 my $f_found; 2296 my $f_hit; 2297 my $br_found; 2298 my $br_hit; 2299 2300 my $testname; 2301 my $filename = $_[2]; 2302 2303 # Retrieve data 2304 ($testdata1, $sumcount1, $funcdata1, $checkdata1, $testfncdata1, 2305 $sumfnccount1, $testbrdata1, $sumbrcount1) = get_info_entry($entry1); 2306 ($testdata2, $sumcount2, $funcdata2, $checkdata2, $testfncdata2, 2307 $sumfnccount2, $testbrdata2, $sumbrcount2) = get_info_entry($entry2); 2308 2309 # Merge checksums 2310 $checkdata1 = merge_checksums($checkdata1, $checkdata2, $filename); 2311 2312 # Combine funcdata 2313 $result_funcdata = merge_func_data($funcdata1, $funcdata2, $filename); 2314 2315 # Combine function call count data 2316 $result_testfncdata = add_testfncdata($testfncdata1, $testfncdata2); 2317 ($result_sumfnccount, $f_found, $f_hit) = 2318 add_fnccount($sumfnccount1, $sumfnccount2); 2319 2320 # Combine branch coverage data 2321 $result_testbrdata = add_testbrdata($testbrdata1, $testbrdata2); 2322 ($result_sumbrcount, $br_found, $br_hit) = 2323 combine_brcount($sumbrcount1, $sumbrcount2, $BR_ADD); 2324 2325 # Combine testdata 2326 foreach $testname (keys(%{$testdata1})) 2327 { 2328 if (defined($testdata2->{$testname})) 2329 { 2330 # testname is present in both entries, requires 2331 # combination 2332 ($result_testdata{$testname}) = 2333 add_counts($testdata1->{$testname}, 2334 $testdata2->{$testname}); 2335 } 2336 else 2337 { 2338 # testname only present in entry1, add to result 2339 $result_testdata{$testname} = $testdata1->{$testname}; 2340 } 2341 2342 # update sum count hash 2343 ($result_sumcount, $lines_found, $lines_hit) = 2344 add_counts($result_sumcount, 2345 $result_testdata{$testname}); 2346 } 2347 2348 foreach $testname (keys(%{$testdata2})) 2349 { 2350 # Skip testnames already covered by previous iteration 2351 if (defined($testdata1->{$testname})) { next; } 2352 2353 # testname only present in entry2, add to result hash 2354 $result_testdata{$testname} = $testdata2->{$testname}; 2355 2356 # update sum count hash 2357 ($result_sumcount, $lines_found, $lines_hit) = 2358 add_counts($result_sumcount, 2359 $result_testdata{$testname}); 2360 } 2361 2362 # Calculate resulting sumcount 2363 2364 # Store result 2365 set_info_entry(\%result, \%result_testdata, $result_sumcount, 2366 $result_funcdata, $checkdata1, $result_testfncdata, 2367 $result_sumfnccount, $result_testbrdata, 2368 $result_sumbrcount, $lines_found, $lines_hit, 2369 $f_found, $f_hit, $br_found, $br_hit); 2370 2371 return(\%result); 2372 } 2373 2374 2375 # 2376 # combine_info_files(info_ref1, info_ref2) 2377 # 2378 # Combine .info data in hashes referenced by INFO_REF1 and INFO_REF2. Return 2379 # reference to resulting hash. 2380 # 2381 2382 sub combine_info_files($$) 2383 { 2384 my %hash1 = %{$_[0]}; 2385 my %hash2 = %{$_[1]}; 2386 my $filename; 2387 2388 foreach $filename (keys(%hash2)) 2389 { 2390 if ($hash1{$filename}) 2391 { 2392 # Entry already exists in hash1, combine them 2393 $hash1{$filename} = 2394 combine_info_entries($hash1{$filename}, 2395 $hash2{$filename}, 2396 $filename); 2397 } 2398 else 2399 { 2400 # Entry is unique in both hashes, simply add to 2401 # resulting hash 2402 $hash1{$filename} = $hash2{$filename}; 2403 } 2404 } 2405 2406 return(\%hash1); 2407 } 2408 2409 2410 # 2411 # add_traces() 2412 # 2413 2414 sub add_traces() 2415 { 2416 my $total_trace; 2417 my $current_trace; 2418 my $tracefile; 2419 my @result; 2420 local *INFO_HANDLE; 2421 2422 info("Combining tracefiles.\n"); 2423 2424 foreach $tracefile (@add_tracefile) 2425 { 2426 $current_trace = read_info_file($tracefile); 2427 if ($total_trace) 2428 { 2429 $total_trace = combine_info_files($total_trace, 2430 $current_trace); 2431 } 2432 else 2433 { 2434 $total_trace = $current_trace; 2435 } 2436 } 2437 2438 # Write combined data 2439 if ($to_file) 2440 { 2441 info("Writing data to $output_filename\n"); 2442 open(INFO_HANDLE, ">$output_filename") 2443 or die("ERROR: cannot write to $output_filename!\n"); 2444 @result = write_info_file(*INFO_HANDLE, $total_trace); 2445 close(*INFO_HANDLE); 2446 } 2447 else 2448 { 2449 @result = write_info_file(*STDOUT, $total_trace); 2450 } 2451 2452 return @result; 2453 } 2454 2455 2456 # 2457 # write_info_file(filehandle, data) 2458 # 2459 2460 sub write_info_file(*$) 2461 { 2462 local *INFO_HANDLE = $_[0]; 2463 my %data = %{$_[1]}; 2464 my $source_file; 2465 my $entry; 2466 my $testdata; 2467 my $sumcount; 2468 my $funcdata; 2469 my $checkdata; 2470 my $testfncdata; 2471 my $sumfnccount; 2472 my $testbrdata; 2473 my $sumbrcount; 2474 my $testname; 2475 my $line; 2476 my $func; 2477 my $testcount; 2478 my $testfnccount; 2479 my $testbrcount; 2480 my $found; 2481 my $hit; 2482 my $f_found; 2483 my $f_hit; 2484 my $br_found; 2485 my $br_hit; 2486 my $ln_total_found = 0; 2487 my $ln_total_hit = 0; 2488 my $fn_total_found = 0; 2489 my $fn_total_hit = 0; 2490 my $br_total_found = 0; 2491 my $br_total_hit = 0; 2492 2493 foreach $source_file (sort(keys(%data))) 2494 { 2495 $entry = $data{$source_file}; 2496 ($testdata, $sumcount, $funcdata, $checkdata, $testfncdata, 2497 $sumfnccount, $testbrdata, $sumbrcount, $found, $hit, 2498 $f_found, $f_hit, $br_found, $br_hit) = 2499 get_info_entry($entry); 2500 2501 # Add to totals 2502 $ln_total_found += $found; 2503 $ln_total_hit += $hit; 2504 $fn_total_found += $f_found; 2505 $fn_total_hit += $f_hit; 2506 $br_total_found += $br_found; 2507 $br_total_hit += $br_hit; 2508 2509 foreach $testname (sort(keys(%{$testdata}))) 2510 { 2511 $testcount = $testdata->{$testname}; 2512 $testfnccount = $testfncdata->{$testname}; 2513 $testbrcount = $testbrdata->{$testname}; 2514 $found = 0; 2515 $hit = 0; 2516 2517 print(INFO_HANDLE "TN:$testname\n"); 2518 print(INFO_HANDLE "SF:$source_file\n"); 2519 2520 # Write function related data 2521 foreach $func ( 2522 sort({$funcdata->{$a} <=> $funcdata->{$b}} 2523 keys(%{$funcdata}))) 2524 { 2525 print(INFO_HANDLE "FN:".$funcdata->{$func}. 2526 ",$func\n"); 2527 } 2528 foreach $func (keys(%{$testfnccount})) { 2529 print(INFO_HANDLE "FNDA:". 2530 $testfnccount->{$func}. 2531 ",$func\n"); 2532 } 2533 ($f_found, $f_hit) = 2534 get_func_found_and_hit($testfnccount); 2535 print(INFO_HANDLE "FNF:$f_found\n"); 2536 print(INFO_HANDLE "FNH:$f_hit\n"); 2537 2538 # Write branch related data 2539 $br_found = 0; 2540 $br_hit = 0; 2541 foreach $line (sort({$a <=> $b} 2542 keys(%{$testbrcount}))) { 2543 my $brdata = $testbrcount->{$line}; 2544 my $num = br_ivec_len($brdata); 2545 my $i; 2546 2547 for ($i = 0; $i < $num; $i++) { 2548 my ($block, $branch, $taken) = 2549 br_ivec_get($brdata, $i); 2550 2551 print(INFO_HANDLE "BRDA:$line,$block,". 2552 "$branch,$taken\n"); 2553 $br_found++; 2554 $br_hit++ if ($taken ne '-' && 2555 $taken > 0); 2556 } 2557 } 2558 if ($br_found > 0) { 2559 print(INFO_HANDLE "BRF:$br_found\n"); 2560 print(INFO_HANDLE "BRH:$br_hit\n"); 2561 } 2562 2563 # Write line related data 2564 foreach $line (sort({$a <=> $b} keys(%{$testcount}))) 2565 { 2566 print(INFO_HANDLE "DA:$line,". 2567 $testcount->{$line}. 2568 (defined($checkdata->{$line}) && 2569 $checksum ? 2570 ",".$checkdata->{$line} : "")."\n"); 2571 $found++; 2572 if ($testcount->{$line} > 0) 2573 { 2574 $hit++; 2575 } 2576 2577 } 2578 print(INFO_HANDLE "LF:$found\n"); 2579 print(INFO_HANDLE "LH:$hit\n"); 2580 print(INFO_HANDLE "end_of_record\n"); 2581 } 2582 } 2583 2584 return ($ln_total_found, $ln_total_hit, $fn_total_found, $fn_total_hit, 2585 $br_total_found, $br_total_hit); 2586 } 2587 2588 2589 # 2590 # transform_pattern(pattern) 2591 # 2592 # Transform shell wildcard expression to equivalent PERL regular expression. 2593 # Return transformed pattern. 2594 # 2595 2596 sub transform_pattern($) 2597 { 2598 my $pattern = $_[0]; 2599 2600 # Escape special chars 2601 2602 $pattern =~ s/\\/\\\\/g; 2603 $pattern =~ s/\//\\\//g; 2604 $pattern =~ s/\^/\\\^/g; 2605 $pattern =~ s/\$/\\\$/g; 2606 $pattern =~ s/\(/\\\(/g; 2607 $pattern =~ s/\)/\\\)/g; 2608 $pattern =~ s/\[/\\\[/g; 2609 $pattern =~ s/\]/\\\]/g; 2610 $pattern =~ s/\{/\\\{/g; 2611 $pattern =~ s/\}/\\\}/g; 2612 $pattern =~ s/\./\\\./g; 2613 $pattern =~ s/\,/\\\,/g; 2614 $pattern =~ s/\|/\\\|/g; 2615 $pattern =~ s/\+/\\\+/g; 2616 $pattern =~ s/\!/\\\!/g; 2617 2618 # Transform ? => (.) and * => (.*) 2619 2620 $pattern =~ s/\*/\(\.\*\)/g; 2621 $pattern =~ s/\?/\(\.\)/g; 2622 2623 return $pattern; 2624 } 2625 2626 2627 # 2628 # extract() 2629 # 2630 2631 sub extract() 2632 { 2633 my $data = read_info_file($extract); 2634 my $filename; 2635 my $keep; 2636 my $pattern; 2637 my @pattern_list; 2638 my $extracted = 0; 2639 my @result; 2640 local *INFO_HANDLE; 2641 2642 # Need perlreg expressions instead of shell pattern 2643 @pattern_list = map({ transform_pattern($_); } @ARGV); 2644 2645 # Filter out files which do not match any pattern 2646 foreach $filename (sort(keys(%{$data}))) 2647 { 2648 $keep = 0; 2649 2650 foreach $pattern (@pattern_list) 2651 { 2652 $keep ||= ($filename =~ (/^$pattern$/)); 2653 } 2654 2655 2656 if (!$keep) 2657 { 2658 delete($data->{$filename}); 2659 } 2660 else 2661 { 2662 info("Extracting $filename\n"), 2663 $extracted++; 2664 } 2665 } 2666 2667 # Write extracted data 2668 if ($to_file) 2669 { 2670 info("Extracted $extracted files\n"); 2671 info("Writing data to $output_filename\n"); 2672 open(INFO_HANDLE, ">$output_filename") 2673 or die("ERROR: cannot write to $output_filename!\n"); 2674 @result = write_info_file(*INFO_HANDLE, $data); 2675 close(*INFO_HANDLE); 2676 } 2677 else 2678 { 2679 @result = write_info_file(*STDOUT, $data); 2680 } 2681 2682 return @result; 2683 } 2684 2685 2686 # 2687 # remove() 2688 # 2689 2690 sub remove() 2691 { 2692 my $data = read_info_file($remove); 2693 my $filename; 2694 my $match_found; 2695 my $pattern; 2696 my @pattern_list; 2697 my $removed = 0; 2698 my @result; 2699 local *INFO_HANDLE; 2700 2701 # Need perlreg expressions instead of shell pattern 2702 @pattern_list = map({ transform_pattern($_); } @ARGV); 2703 2704 # Filter out files that match the pattern 2705 foreach $filename (sort(keys(%{$data}))) 2706 { 2707 $match_found = 0; 2708 2709 foreach $pattern (@pattern_list) 2710 { 2711 $match_found ||= ($filename =~ (/$pattern$/)); 2712 } 2713 2714 2715 if ($match_found) 2716 { 2717 delete($data->{$filename}); 2718 info("Removing $filename\n"), 2719 $removed++; 2720 } 2721 } 2722 2723 # Write data 2724 if ($to_file) 2725 { 2726 info("Deleted $removed files\n"); 2727 info("Writing data to $output_filename\n"); 2728 open(INFO_HANDLE, ">$output_filename") 2729 or die("ERROR: cannot write to $output_filename!\n"); 2730 @result = write_info_file(*INFO_HANDLE, $data); 2731 close(*INFO_HANDLE); 2732 } 2733 else 2734 { 2735 @result = write_info_file(*STDOUT, $data); 2736 } 2737 2738 return @result; 2739 } 2740 2741 2742 # get_prefix(max_width, max_percentage_too_long, path_list) 2743 # 2744 # Return a path prefix that satisfies the following requirements: 2745 # - is shared by more paths in path_list than any other prefix 2746 # - the percentage of paths which would exceed the given max_width length 2747 # after applying the prefix does not exceed max_percentage_too_long 2748 # 2749 # If multiple prefixes satisfy all requirements, the longest prefix is 2750 # returned. Return an empty string if no prefix could be found. 2751 2752 sub get_prefix($$@) 2753 { 2754 my ($max_width, $max_long, @path_list) = @_; 2755 my $path; 2756 my $ENTRY_NUM = 0; 2757 my $ENTRY_LONG = 1; 2758 my %prefix; 2759 2760 # Build prefix hash 2761 foreach $path (@path_list) { 2762 my ($v, $d, $f) = splitpath($path); 2763 my @dirs = splitdir($d); 2764 my $p_len = length($path); 2765 my $i; 2766 2767 # Remove trailing '/' 2768 pop(@dirs) if ($dirs[scalar(@dirs) - 1] eq ''); 2769 for ($i = 0; $i < scalar(@dirs); $i++) { 2770 my $subpath = catpath($v, catdir(@dirs[0..$i]), ''); 2771 my $entry = $prefix{$subpath}; 2772 2773 $entry = [ 0, 0 ] if (!defined($entry)); 2774 $entry->[$ENTRY_NUM]++; 2775 if (($p_len - length($subpath) - 1) > $max_width) { 2776 $entry->[$ENTRY_LONG]++; 2777 } 2778 $prefix{$subpath} = $entry; 2779 } 2780 } 2781 # Find suitable prefix (sort descending by two keys: 1. number of 2782 # entries covered by a prefix, 2. length of prefix) 2783 foreach $path (sort {($prefix{$a}->[$ENTRY_NUM] == 2784 $prefix{$b}->[$ENTRY_NUM]) ? 2785 length($b) <=> length($a) : 2786 $prefix{$b}->[$ENTRY_NUM] <=> 2787 $prefix{$a}->[$ENTRY_NUM]} 2788 keys(%prefix)) { 2789 my ($num, $long) = @{$prefix{$path}}; 2790 2791 # Check for additional requirement: number of filenames 2792 # that would be too long may not exceed a certain percentage 2793 if ($long <= $num * $max_long / 100) { 2794 return $path; 2795 } 2796 } 2797 2798 return ""; 2799 } 2800 2801 2802 # 2803 # shorten_filename(filename, width) 2804 # 2805 # Truncate filename if it is longer than width characters. 2806 # 2807 2808 sub shorten_filename($$) 2809 { 2810 my ($filename, $width) = @_; 2811 my $l = length($filename); 2812 my $s; 2813 my $e; 2814 2815 return $filename if ($l <= $width); 2816 $e = int(($width - 3) / 2); 2817 $s = $width - 3 - $e; 2818 2819 return substr($filename, 0, $s).'...'.substr($filename, $l - $e); 2820 } 2821 2822 2823 sub shorten_number($$) 2824 { 2825 my ($number, $width) = @_; 2826 my $result = sprintf("%*d", $width, $number); 2827 2828 return $result if (length($result) <= $width); 2829 $number = $number / 1000; 2830 return $result if (length($result) <= $width); 2831 $result = sprintf("%*dk", $width - 1, $number); 2832 return $result if (length($result) <= $width); 2833 $number = $number / 1000; 2834 $result = sprintf("%*dM", $width - 1, $number); 2835 return $result if (length($result) <= $width); 2836 return '#'; 2837 } 2838 2839 sub shorten_rate($$) 2840 { 2841 my ($rate, $width) = @_; 2842 my $result = sprintf("%*.1f%%", $width - 3, $rate); 2843 2844 return $result if (length($result) <= $width); 2845 $result = sprintf("%*d%%", $width - 1, $rate); 2846 return $result if (length($result) <= $width); 2847 return "#"; 2848 } 2849 2850 # 2851 # list() 2852 # 2853 2854 sub list() 2855 { 2856 my $data = read_info_file($list); 2857 my $filename; 2858 my $found; 2859 my $hit; 2860 my $entry; 2861 my $fn_found; 2862 my $fn_hit; 2863 my $br_found; 2864 my $br_hit; 2865 my $total_found = 0; 2866 my $total_hit = 0; 2867 my $fn_total_found = 0; 2868 my $fn_total_hit = 0; 2869 my $br_total_found = 0; 2870 my $br_total_hit = 0; 2871 my $prefix; 2872 my $strlen = length("Filename"); 2873 my $format; 2874 my $heading1; 2875 my $heading2; 2876 my @footer; 2877 my $barlen; 2878 my $rate; 2879 my $fnrate; 2880 my $brrate; 2881 my $lastpath; 2882 my $F_LN_NUM = 0; 2883 my $F_LN_RATE = 1; 2884 my $F_FN_NUM = 2; 2885 my $F_FN_RATE = 3; 2886 my $F_BR_NUM = 4; 2887 my $F_BR_RATE = 5; 2888 my @fwidth_narrow = (5, 5, 3, 5, 4, 5); 2889 my @fwidth_wide = (6, 5, 5, 5, 6, 5); 2890 my @fwidth = @fwidth_wide; 2891 my $w; 2892 my $max_width = $opt_list_width; 2893 my $max_long = $opt_list_truncate_max; 2894 my $fwidth_narrow_length; 2895 my $fwidth_wide_length; 2896 my $got_prefix = 0; 2897 my $root_prefix = 0; 2898 2899 # Calculate total width of narrow fields 2900 $fwidth_narrow_length = 0; 2901 foreach $w (@fwidth_narrow) { 2902 $fwidth_narrow_length += $w + 1; 2903 } 2904 # Calculate total width of wide fields 2905 $fwidth_wide_length = 0; 2906 foreach $w (@fwidth_wide) { 2907 $fwidth_wide_length += $w + 1; 2908 } 2909 # Get common file path prefix 2910 $prefix = get_prefix($max_width - $fwidth_narrow_length, $max_long, 2911 keys(%{$data})); 2912 $root_prefix = 1 if ($prefix eq rootdir()); 2913 $got_prefix = 1 if (length($prefix) > 0); 2914 $prefix =~ s/\/$//; 2915 # Get longest filename length 2916 foreach $filename (keys(%{$data})) { 2917 if (!$opt_list_full_path) { 2918 if (!$got_prefix || !$root_prefix && 2919 !($filename =~ s/^\Q$prefix\/\E//)) { 2920 my ($v, $d, $f) = splitpath($filename); 2921 2922 $filename = $f; 2923 } 2924 } 2925 # Determine maximum length of entries 2926 if (length($filename) > $strlen) { 2927 $strlen = length($filename) 2928 } 2929 } 2930 if (!$opt_list_full_path) { 2931 my $blanks; 2932 2933 $w = $fwidth_wide_length; 2934 # Check if all columns fit into max_width characters 2935 if ($strlen + $fwidth_wide_length > $max_width) { 2936 # Use narrow fields 2937 @fwidth = @fwidth_narrow; 2938 $w = $fwidth_narrow_length; 2939 if (($strlen + $fwidth_narrow_length) > $max_width) { 2940 # Truncate filenames at max width 2941 $strlen = $max_width - $fwidth_narrow_length; 2942 } 2943 } 2944 # Add some blanks between filename and fields if possible 2945 $blanks = int($strlen * 0.5); 2946 $blanks = 4 if ($blanks < 4); 2947 $blanks = 8 if ($blanks > 8); 2948 if (($strlen + $w + $blanks) < $max_width) { 2949 $strlen += $blanks; 2950 } else { 2951 $strlen = $max_width - $w; 2952 } 2953 } 2954 # Filename 2955 $w = $strlen; 2956 $format = "%-${w}s|"; 2957 $heading1 = sprintf("%*s|", $w, ""); 2958 $heading2 = sprintf("%-*s|", $w, "Filename"); 2959 $barlen = $w + 1; 2960 # Line coverage rate 2961 $w = $fwidth[$F_LN_RATE]; 2962 $format .= "%${w}s "; 2963 $heading1 .= sprintf("%-*s |", $w + $fwidth[$F_LN_NUM], 2964 "Lines"); 2965 $heading2 .= sprintf("%-*s ", $w, "Rate"); 2966 $barlen += $w + 1; 2967 # Number of lines 2968 $w = $fwidth[$F_LN_NUM]; 2969 $format .= "%${w}s|"; 2970 $heading2 .= sprintf("%*s|", $w, "Num"); 2971 $barlen += $w + 1; 2972 # Function coverage rate 2973 $w = $fwidth[$F_FN_RATE]; 2974 $format .= "%${w}s "; 2975 $heading1 .= sprintf("%-*s|", $w + $fwidth[$F_FN_NUM] + 1, 2976 "Functions"); 2977 $heading2 .= sprintf("%-*s ", $w, "Rate"); 2978 $barlen += $w + 1; 2979 # Number of functions 2980 $w = $fwidth[$F_FN_NUM]; 2981 $format .= "%${w}s|"; 2982 $heading2 .= sprintf("%*s|", $w, "Num"); 2983 $barlen += $w + 1; 2984 # Branch coverage rate 2985 $w = $fwidth[$F_BR_RATE]; 2986 $format .= "%${w}s "; 2987 $heading1 .= sprintf("%-*s", $w + $fwidth[$F_BR_NUM] + 1, 2988 "Branches"); 2989 $heading2 .= sprintf("%-*s ", $w, "Rate"); 2990 $barlen += $w + 1; 2991 # Number of branches 2992 $w = $fwidth[$F_BR_NUM]; 2993 $format .= "%${w}s"; 2994 $heading2 .= sprintf("%*s", $w, "Num"); 2995 $barlen += $w; 2996 # Line end 2997 $format .= "\n"; 2998 $heading1 .= "\n"; 2999 $heading2 .= "\n"; 3000 3001 # Print heading 3002 print($heading1); 3003 print($heading2); 3004 print(("="x$barlen)."\n"); 3005 3006 # Print per file information 3007 foreach $filename (sort(keys(%{$data}))) 3008 { 3009 my @file_data; 3010 my $print_filename = $filename; 3011 3012 $entry = $data->{$filename}; 3013 if (!$opt_list_full_path) { 3014 my $p; 3015 3016 $print_filename = $filename; 3017 if (!$got_prefix || !$root_prefix && 3018 !($print_filename =~ s/^\Q$prefix\/\E//)) { 3019 my ($v, $d, $f) = splitpath($filename); 3020 3021 $p = catpath($v, $d, ""); 3022 $p =~ s/\/$//; 3023 $print_filename = $f; 3024 } else { 3025 $p = $prefix; 3026 } 3027 3028 if (!defined($lastpath) || $lastpath ne $p) { 3029 print("\n") if (defined($lastpath)); 3030 $lastpath = $p; 3031 print("[$lastpath/]\n") if (!$root_prefix); 3032 } 3033 $print_filename = shorten_filename($print_filename, 3034 $strlen); 3035 } 3036 3037 (undef, undef, undef, undef, undef, undef, undef, undef, 3038 $found, $hit, $fn_found, $fn_hit, $br_found, $br_hit) = 3039 get_info_entry($entry); 3040 3041 # Assume zero count if there is no function data for this file 3042 if (!defined($fn_found) || !defined($fn_hit)) { 3043 $fn_found = 0; 3044 $fn_hit = 0; 3045 } 3046 # Assume zero count if there is no branch data for this file 3047 if (!defined($br_found) || !defined($br_hit)) { 3048 $br_found = 0; 3049 $br_hit = 0; 3050 } 3051 3052 # Add line coverage totals 3053 $total_found += $found; 3054 $total_hit += $hit; 3055 # Add function coverage totals 3056 $fn_total_found += $fn_found; 3057 $fn_total_hit += $fn_hit; 3058 # Add branch coverage totals 3059 $br_total_found += $br_found; 3060 $br_total_hit += $br_hit; 3061 3062 # Determine line coverage rate for this file 3063 if ($found == 0) { 3064 $rate = "-"; 3065 } else { 3066 $rate = shorten_rate(100 * $hit / $found, 3067 $fwidth[$F_LN_RATE]); 3068 } 3069 # Determine function coverage rate for this file 3070 if (!defined($fn_found) || $fn_found == 0) { 3071 $fnrate = "-"; 3072 } else { 3073 $fnrate = shorten_rate(100 * $fn_hit / $fn_found, 3074 $fwidth[$F_FN_RATE]); 3075 } 3076 # Determine branch coverage rate for this file 3077 if (!defined($br_found) || $br_found == 0) { 3078 $brrate = "-"; 3079 } else { 3080 $brrate = shorten_rate(100 * $br_hit / $br_found, 3081 $fwidth[$F_BR_RATE]); 3082 } 3083 3084 # Assemble line parameters 3085 push(@file_data, $print_filename); 3086 push(@file_data, $rate); 3087 push(@file_data, shorten_number($found, $fwidth[$F_LN_NUM])); 3088 push(@file_data, $fnrate); 3089 push(@file_data, shorten_number($fn_found, $fwidth[$F_FN_NUM])); 3090 push(@file_data, $brrate); 3091 push(@file_data, shorten_number($br_found, $fwidth[$F_BR_NUM])); 3092 3093 # Print assembled line 3094 printf($format, @file_data); 3095 } 3096 3097 # Determine total line coverage rate 3098 if ($total_found == 0) { 3099 $rate = "-"; 3100 } else { 3101 $rate = shorten_rate(100 * $total_hit / $total_found, 3102 $fwidth[$F_LN_RATE]); 3103 } 3104 # Determine total function coverage rate 3105 if ($fn_total_found == 0) { 3106 $fnrate = "-"; 3107 } else { 3108 $fnrate = shorten_rate(100 * $fn_total_hit / $fn_total_found, 3109 $fwidth[$F_FN_RATE]); 3110 } 3111 # Determine total branch coverage rate 3112 if ($br_total_found == 0) { 3113 $brrate = "-"; 3114 } else { 3115 $brrate = shorten_rate(100 * $br_total_hit / $br_total_found, 3116 $fwidth[$F_BR_RATE]); 3117 } 3118 3119 # Print separator 3120 print(("="x$barlen)."\n"); 3121 3122 # Assemble line parameters 3123 push(@footer, sprintf("%*s", $strlen, "Total:")); 3124 push(@footer, $rate); 3125 push(@footer, shorten_number($total_found, $fwidth[$F_LN_NUM])); 3126 push(@footer, $fnrate); 3127 push(@footer, shorten_number($fn_total_found, $fwidth[$F_FN_NUM])); 3128 push(@footer, $brrate); 3129 push(@footer, shorten_number($br_total_found, $fwidth[$F_BR_NUM])); 3130 3131 # Print assembled line 3132 printf($format, @footer); 3133 } 3134 3135 3136 # 3137 # get_common_filename(filename1, filename2) 3138 # 3139 # Check for filename components which are common to FILENAME1 and FILENAME2. 3140 # Upon success, return 3141 # 3142 # (common, path1, path2) 3143 # 3144 # or 'undef' in case there are no such parts. 3145 # 3146 3147 sub get_common_filename($$) 3148 { 3149 my @list1 = split("/", $_[0]); 3150 my @list2 = split("/", $_[1]); 3151 my @result; 3152 3153 # Work in reverse order, i.e. beginning with the filename itself 3154 while (@list1 && @list2 && ($list1[$#list1] eq $list2[$#list2])) 3155 { 3156 unshift(@result, pop(@list1)); 3157 pop(@list2); 3158 } 3159 3160 # Did we find any similarities? 3161 if (scalar(@result) > 0) 3162 { 3163 return (join("/", @result), join("/", @list1), 3164 join("/", @list2)); 3165 } 3166 else 3167 { 3168 return undef; 3169 } 3170 } 3171 3172 3173 # 3174 # strip_directories($path, $depth) 3175 # 3176 # Remove DEPTH leading directory levels from PATH. 3177 # 3178 3179 sub strip_directories($$) 3180 { 3181 my $filename = $_[0]; 3182 my $depth = $_[1]; 3183 my $i; 3184 3185 if (!defined($depth) || ($depth < 1)) 3186 { 3187 return $filename; 3188 } 3189 for ($i = 0; $i < $depth; $i++) 3190 { 3191 $filename =~ s/^[^\/]*\/+(.*)$/$1/; 3192 } 3193 return $filename; 3194 } 3195 3196 3197 # 3198 # read_diff(filename) 3199 # 3200 # Read diff output from FILENAME to memory. The diff file has to follow the 3201 # format generated by 'diff -u'. Returns a list of hash references: 3202 # 3203 # (mapping, path mapping) 3204 # 3205 # mapping: filename -> reference to line hash 3206 # line hash: line number in new file -> corresponding line number in old file 3207 # 3208 # path mapping: filename -> old filename 3209 # 3210 # Die in case of error. 3211 # 3212 3213 sub read_diff($) 3214 { 3215 my $diff_file = $_[0]; # Name of diff file 3216 my %diff; # Resulting mapping filename -> line hash 3217 my %paths; # Resulting mapping old path -> new path 3218 my $mapping; # Reference to current line hash 3219 my $line; # Contents of current line 3220 my $num_old; # Current line number in old file 3221 my $num_new; # Current line number in new file 3222 my $file_old; # Name of old file in diff section 3223 my $file_new; # Name of new file in diff section 3224 my $filename; # Name of common filename of diff section 3225 my $in_block = 0; # Non-zero while we are inside a diff block 3226 local *HANDLE; # File handle for reading the diff file 3227 3228 info("Reading diff $diff_file\n"); 3229 3230 # Check if file exists and is readable 3231 stat($diff_file); 3232 if (!(-r _)) 3233 { 3234 die("ERROR: cannot read file $diff_file!\n"); 3235 } 3236 3237 # Check if this is really a plain file 3238 if (!(-f _)) 3239 { 3240 die("ERROR: not a plain file: $diff_file!\n"); 3241 } 3242 3243 # Check for .gz extension 3244 if ($diff_file =~ /\.gz$/) 3245 { 3246 # Check for availability of GZIP tool 3247 system_no_output(1, "gunzip", "-h") 3248 and die("ERROR: gunzip command not available!\n"); 3249 3250 # Check integrity of compressed file 3251 system_no_output(1, "gunzip", "-t", $diff_file) 3252 and die("ERROR: integrity check failed for ". 3253 "compressed file $diff_file!\n"); 3254 3255 # Open compressed file 3256 open(HANDLE, "gunzip -c $diff_file|") 3257 or die("ERROR: cannot start gunzip to decompress ". 3258 "file $_[0]!\n"); 3259 } 3260 else 3261 { 3262 # Open decompressed file 3263 open(HANDLE, $diff_file) 3264 or die("ERROR: cannot read file $_[0]!\n"); 3265 } 3266 3267 # Parse diff file line by line 3268 while (<HANDLE>) 3269 { 3270 chomp($_); 3271 $line = $_; 3272 3273 foreach ($line) 3274 { 3275 # Filename of old file: 3276 # --- <filename> <date> 3277 /^--- (\S+)/ && do 3278 { 3279 $file_old = strip_directories($1, $strip); 3280 last; 3281 }; 3282 # Filename of new file: 3283 # +++ <filename> <date> 3284 /^\+\+\+ (\S+)/ && do 3285 { 3286 # Add last file to resulting hash 3287 if ($filename) 3288 { 3289 my %new_hash; 3290 $diff{$filename} = $mapping; 3291 $mapping = \%new_hash; 3292 } 3293 $file_new = strip_directories($1, $strip); 3294 $filename = $file_old; 3295 $paths{$filename} = $file_new; 3296 $num_old = 1; 3297 $num_new = 1; 3298 last; 3299 }; 3300 # Start of diff block: 3301 # @@ -old_start,old_num, +new_start,new_num @@ 3302 /^\@\@\s+-(\d+),(\d+)\s+\+(\d+),(\d+)\s+\@\@$/ && do 3303 { 3304 $in_block = 1; 3305 while ($num_old < $1) 3306 { 3307 $mapping->{$num_new} = $num_old; 3308 $num_old++; 3309 $num_new++; 3310 } 3311 last; 3312 }; 3313 # Unchanged line 3314 # <line starts with blank> 3315 /^ / && do 3316 { 3317 if ($in_block == 0) 3318 { 3319 last; 3320 } 3321 $mapping->{$num_new} = $num_old; 3322 $num_old++; 3323 $num_new++; 3324 last; 3325 }; 3326 # Line as seen in old file 3327 # <line starts with '-'> 3328 /^-/ && do 3329 { 3330 if ($in_block == 0) 3331 { 3332 last; 3333 } 3334 $num_old++; 3335 last; 3336 }; 3337 # Line as seen in new file 3338 # <line starts with '+'> 3339 /^\+/ && do 3340 { 3341 if ($in_block == 0) 3342 { 3343 last; 3344 } 3345 $num_new++; 3346 last; 3347 }; 3348 # Empty line 3349 /^$/ && do 3350 { 3351 if ($in_block == 0) 3352 { 3353 last; 3354 } 3355 $mapping->{$num_new} = $num_old; 3356 $num_old++; 3357 $num_new++; 3358 last; 3359 }; 3360 } 3361 } 3362 3363 close(HANDLE); 3364 3365 # Add final diff file section to resulting hash 3366 if ($filename) 3367 { 3368 $diff{$filename} = $mapping; 3369 } 3370 3371 if (!%diff) 3372 { 3373 die("ERROR: no valid diff data found in $diff_file!\n". 3374 "Make sure to use 'diff -u' when generating the diff ". 3375 "file.\n"); 3376 } 3377 return (\%diff, \%paths); 3378 } 3379 3380 3381 # 3382 # apply_diff($count_data, $line_hash) 3383 # 3384 # Transform count data using a mapping of lines: 3385 # 3386 # $count_data: reference to hash: line number -> data 3387 # $line_hash: reference to hash: line number new -> line number old 3388 # 3389 # Return a reference to transformed count data. 3390 # 3391 3392 sub apply_diff($$) 3393 { 3394 my $count_data = $_[0]; # Reference to data hash: line -> hash 3395 my $line_hash = $_[1]; # Reference to line hash: new line -> old line 3396 my %result; # Resulting hash 3397 my $last_new = 0; # Last new line number found in line hash 3398 my $last_old = 0; # Last old line number found in line hash 3399 3400 # Iterate all new line numbers found in the diff 3401 foreach (sort({$a <=> $b} keys(%{$line_hash}))) 3402 { 3403 $last_new = $_; 3404 $last_old = $line_hash->{$last_new}; 3405 3406 # Is there data associated with the corresponding old line? 3407 if (defined($count_data->{$line_hash->{$_}})) 3408 { 3409 # Copy data to new hash with a new line number 3410 $result{$_} = $count_data->{$line_hash->{$_}}; 3411 } 3412 } 3413 # Transform all other lines which come after the last diff entry 3414 foreach (sort({$a <=> $b} keys(%{$count_data}))) 3415 { 3416 if ($_ <= $last_old) 3417 { 3418 # Skip lines which were covered by line hash 3419 next; 3420 } 3421 # Copy data to new hash with an offset 3422 $result{$_ + ($last_new - $last_old)} = $count_data->{$_}; 3423 } 3424 3425 return \%result; 3426 } 3427 3428 3429 # 3430 # apply_diff_to_brcount(brcount, linedata) 3431 # 3432 # Adjust line numbers of branch coverage data according to linedata. 3433 # 3434 3435 sub apply_diff_to_brcount($$) 3436 { 3437 my ($brcount, $linedata) = @_; 3438 my $db; 3439 3440 # Convert brcount to db format 3441 $db = brcount_to_db($brcount); 3442 # Apply diff to db format 3443 $db = apply_diff($db, $linedata); 3444 # Convert db format back to brcount format 3445 ($brcount) = db_to_brcount($db); 3446 3447 return $brcount; 3448 } 3449 3450 3451 # 3452 # get_hash_max(hash_ref) 3453 # 3454 # Return the highest integer key from hash. 3455 # 3456 3457 sub get_hash_max($) 3458 { 3459 my ($hash) = @_; 3460 my $max; 3461 3462 foreach (keys(%{$hash})) { 3463 if (!defined($max)) { 3464 $max = $_; 3465 } elsif ($hash->{$_} > $max) { 3466 $max = $_; 3467 } 3468 } 3469 return $max; 3470 } 3471 3472 sub get_hash_reverse($) 3473 { 3474 my ($hash) = @_; 3475 my %result; 3476 3477 foreach (keys(%{$hash})) { 3478 $result{$hash->{$_}} = $_; 3479 } 3480 3481 return \%result; 3482 } 3483 3484 # 3485 # apply_diff_to_funcdata(funcdata, line_hash) 3486 # 3487 3488 sub apply_diff_to_funcdata($$) 3489 { 3490 my ($funcdata, $linedata) = @_; 3491 my $last_new = get_hash_max($linedata); 3492 my $last_old = $linedata->{$last_new}; 3493 my $func; 3494 my %result; 3495 my $line_diff = get_hash_reverse($linedata); 3496 3497 foreach $func (keys(%{$funcdata})) { 3498 my $line = $funcdata->{$func}; 3499 3500 if (defined($line_diff->{$line})) { 3501 $result{$func} = $line_diff->{$line}; 3502 } elsif ($line > $last_old) { 3503 $result{$func} = $line + $last_new - $last_old; 3504 } 3505 } 3506 3507 return \%result; 3508 } 3509 3510 3511 # 3512 # get_line_hash($filename, $diff_data, $path_data) 3513 # 3514 # Find line hash in DIFF_DATA which matches FILENAME. On success, return list 3515 # line hash. or undef in case of no match. Die if more than one line hashes in 3516 # DIFF_DATA match. 3517 # 3518 3519 sub get_line_hash($$$) 3520 { 3521 my $filename = $_[0]; 3522 my $diff_data = $_[1]; 3523 my $path_data = $_[2]; 3524 my $conversion; 3525 my $old_path; 3526 my $new_path; 3527 my $diff_name; 3528 my $common; 3529 my $old_depth; 3530 my $new_depth; 3531 3532 # Remove trailing slash from diff path 3533 $diff_path =~ s/\/$//; 3534 foreach (keys(%{$diff_data})) 3535 { 3536 my $sep = ""; 3537 3538 $sep = '/' if (!/^\//); 3539 3540 # Try to match diff filename with filename 3541 if ($filename =~ /^\Q$diff_path$sep$_\E$/) 3542 { 3543 if ($diff_name) 3544 { 3545 # Two files match, choose the more specific one 3546 # (the one with more path components) 3547 $old_depth = ($diff_name =~ tr/\///); 3548 $new_depth = (tr/\///); 3549 if ($old_depth == $new_depth) 3550 { 3551 die("ERROR: diff file contains ". 3552 "ambiguous entries for ". 3553 "$filename\n"); 3554 } 3555 elsif ($new_depth > $old_depth) 3556 { 3557 $diff_name = $_; 3558 } 3559 } 3560 else 3561 { 3562 $diff_name = $_; 3563 } 3564 }; 3565 } 3566 if ($diff_name) 3567 { 3568 # Get converted path 3569 if ($filename =~ /^(.*)$diff_name$/) 3570 { 3571 ($common, $old_path, $new_path) = 3572 get_common_filename($filename, 3573 $1.$path_data->{$diff_name}); 3574 } 3575 return ($diff_data->{$diff_name}, $old_path, $new_path); 3576 } 3577 else 3578 { 3579 return undef; 3580 } 3581 } 3582 3583 3584 # 3585 # convert_paths(trace_data, path_conversion_data) 3586 # 3587 # Rename all paths in TRACE_DATA which show up in PATH_CONVERSION_DATA. 3588 # 3589 3590 sub convert_paths($$) 3591 { 3592 my $trace_data = $_[0]; 3593 my $path_conversion_data = $_[1]; 3594 my $filename; 3595 my $new_path; 3596 3597 if (scalar(keys(%{$path_conversion_data})) == 0) 3598 { 3599 info("No path conversion data available.\n"); 3600 return; 3601 } 3602 3603 # Expand path conversion list 3604 foreach $filename (keys(%{$path_conversion_data})) 3605 { 3606 $new_path = $path_conversion_data->{$filename}; 3607 while (($filename =~ s/^(.*)\/[^\/]+$/$1/) && 3608 ($new_path =~ s/^(.*)\/[^\/]+$/$1/) && 3609 ($filename ne $new_path)) 3610 { 3611 $path_conversion_data->{$filename} = $new_path; 3612 } 3613 } 3614 3615 # Adjust paths 3616 FILENAME: foreach $filename (keys(%{$trace_data})) 3617 { 3618 # Find a path in our conversion table that matches, starting 3619 # with the longest path 3620 foreach (sort({length($b) <=> length($a)} 3621 keys(%{$path_conversion_data}))) 3622 { 3623 # Is this path a prefix of our filename? 3624 if (!($filename =~ /^$_(.*)$/)) 3625 { 3626 next; 3627 } 3628 $new_path = $path_conversion_data->{$_}.$1; 3629 3630 # Make sure not to overwrite an existing entry under 3631 # that path name 3632 if ($trace_data->{$new_path}) 3633 { 3634 # Need to combine entries 3635 $trace_data->{$new_path} = 3636 combine_info_entries( 3637 $trace_data->{$filename}, 3638 $trace_data->{$new_path}, 3639 $filename); 3640 } 3641 else 3642 { 3643 # Simply rename entry 3644 $trace_data->{$new_path} = 3645 $trace_data->{$filename}; 3646 } 3647 delete($trace_data->{$filename}); 3648 next FILENAME; 3649 } 3650 info("No conversion available for filename $filename\n"); 3651 } 3652 } 3653 3654 # 3655 # sub adjust_fncdata(funcdata, testfncdata, sumfnccount) 3656 # 3657 # Remove function call count data from testfncdata and sumfnccount which 3658 # is no longer present in funcdata. 3659 # 3660 3661 sub adjust_fncdata($$$) 3662 { 3663 my ($funcdata, $testfncdata, $sumfnccount) = @_; 3664 my $testname; 3665 my $func; 3666 my $f_found; 3667 my $f_hit; 3668 3669 # Remove count data in testfncdata for functions which are no longer 3670 # in funcdata 3671 foreach $testname (%{$testfncdata}) { 3672 my $fnccount = $testfncdata->{$testname}; 3673 3674 foreach $func (%{$fnccount}) { 3675 if (!defined($funcdata->{$func})) { 3676 delete($fnccount->{$func}); 3677 } 3678 } 3679 } 3680 # Remove count data in sumfnccount for functions which are no longer 3681 # in funcdata 3682 foreach $func (%{$sumfnccount}) { 3683 if (!defined($funcdata->{$func})) { 3684 delete($sumfnccount->{$func}); 3685 } 3686 } 3687 } 3688 3689 # 3690 # get_func_found_and_hit(sumfnccount) 3691 # 3692 # Return (f_found, f_hit) for sumfnccount 3693 # 3694 3695 sub get_func_found_and_hit($) 3696 { 3697 my ($sumfnccount) = @_; 3698 my $function; 3699 my $f_found; 3700 my $f_hit; 3701 3702 $f_found = scalar(keys(%{$sumfnccount})); 3703 $f_hit = 0; 3704 foreach $function (keys(%{$sumfnccount})) { 3705 if ($sumfnccount->{$function} > 0) { 3706 $f_hit++; 3707 } 3708 } 3709 return ($f_found, $f_hit); 3710 } 3711 3712 # 3713 # diff() 3714 # 3715 3716 sub diff() 3717 { 3718 my $trace_data = read_info_file($diff); 3719 my $diff_data; 3720 my $path_data; 3721 my $old_path; 3722 my $new_path; 3723 my %path_conversion_data; 3724 my $filename; 3725 my $line_hash; 3726 my $new_name; 3727 my $entry; 3728 my $testdata; 3729 my $testname; 3730 my $sumcount; 3731 my $funcdata; 3732 my $checkdata; 3733 my $testfncdata; 3734 my $sumfnccount; 3735 my $testbrdata; 3736 my $sumbrcount; 3737 my $found; 3738 my $hit; 3739 my $f_found; 3740 my $f_hit; 3741 my $br_found; 3742 my $br_hit; 3743 my $converted = 0; 3744 my $unchanged = 0; 3745 my @result; 3746 local *INFO_HANDLE; 3747 3748 ($diff_data, $path_data) = read_diff($ARGV[0]); 3749 3750 foreach $filename (sort(keys(%{$trace_data}))) 3751 { 3752 # Find a diff section corresponding to this file 3753 ($line_hash, $old_path, $new_path) = 3754 get_line_hash($filename, $diff_data, $path_data); 3755 if (!$line_hash) 3756 { 3757 # There's no diff section for this file 3758 $unchanged++; 3759 next; 3760 } 3761 $converted++; 3762 if ($old_path && $new_path && ($old_path ne $new_path)) 3763 { 3764 $path_conversion_data{$old_path} = $new_path; 3765 } 3766 # Check for deleted files 3767 if (scalar(keys(%{$line_hash})) == 0) 3768 { 3769 info("Removing $filename\n"); 3770 delete($trace_data->{$filename}); 3771 next; 3772 } 3773 info("Converting $filename\n"); 3774 $entry = $trace_data->{$filename}; 3775 ($testdata, $sumcount, $funcdata, $checkdata, $testfncdata, 3776 $sumfnccount, $testbrdata, $sumbrcount) = 3777 get_info_entry($entry); 3778 # Convert test data 3779 foreach $testname (keys(%{$testdata})) 3780 { 3781 # Adjust line numbers of line coverage data 3782 $testdata->{$testname} = 3783 apply_diff($testdata->{$testname}, $line_hash); 3784 # Adjust line numbers of branch coverage data 3785 $testbrdata->{$testname} = 3786 apply_diff_to_brcount($testbrdata->{$testname}, 3787 $line_hash); 3788 # Remove empty sets of test data 3789 if (scalar(keys(%{$testdata->{$testname}})) == 0) 3790 { 3791 delete($testdata->{$testname}); 3792 delete($testfncdata->{$testname}); 3793 delete($testbrdata->{$testname}); 3794 } 3795 } 3796 # Rename test data to indicate conversion 3797 foreach $testname (keys(%{$testdata})) 3798 { 3799 # Skip testnames which already contain an extension 3800 if ($testname =~ /,[^,]+$/) 3801 { 3802 next; 3803 } 3804 # Check for name conflict 3805 if (defined($testdata->{$testname.",diff"})) 3806 { 3807 # Add counts 3808 ($testdata->{$testname}) = add_counts( 3809 $testdata->{$testname}, 3810 $testdata->{$testname.",diff"}); 3811 delete($testdata->{$testname.",diff"}); 3812 # Add function call counts 3813 ($testfncdata->{$testname}) = add_fnccount( 3814 $testfncdata->{$testname}, 3815 $testfncdata->{$testname.",diff"}); 3816 delete($testfncdata->{$testname.",diff"}); 3817 # Add branch counts 3818 ($testbrdata->{$testname}) = combine_brcount( 3819 $testbrdata->{$testname}, 3820 $testbrdata->{$testname.",diff"}, 3821 $BR_ADD); 3822 delete($testbrdata->{$testname.",diff"}); 3823 } 3824 # Move test data to new testname 3825 $testdata->{$testname.",diff"} = $testdata->{$testname}; 3826 delete($testdata->{$testname}); 3827 # Move function call count data to new testname 3828 $testfncdata->{$testname.",diff"} = 3829 $testfncdata->{$testname}; 3830 delete($testfncdata->{$testname}); 3831 # Move branch count data to new testname 3832 $testbrdata->{$testname.",diff"} = 3833 $testbrdata->{$testname}; 3834 delete($testbrdata->{$testname}); 3835 } 3836 # Convert summary of test data 3837 $sumcount = apply_diff($sumcount, $line_hash); 3838 # Convert function data 3839 $funcdata = apply_diff_to_funcdata($funcdata, $line_hash); 3840 # Convert branch coverage data 3841 $sumbrcount = apply_diff_to_brcount($sumbrcount, $line_hash); 3842 # Update found/hit numbers 3843 # Convert checksum data 3844 $checkdata = apply_diff($checkdata, $line_hash); 3845 # Convert function call count data 3846 adjust_fncdata($funcdata, $testfncdata, $sumfnccount); 3847 ($f_found, $f_hit) = get_func_found_and_hit($sumfnccount); 3848 ($br_found, $br_hit) = get_br_found_and_hit($sumbrcount); 3849 # Update found/hit numbers 3850 $found = 0; 3851 $hit = 0; 3852 foreach (keys(%{$sumcount})) 3853 { 3854 $found++; 3855 if ($sumcount->{$_} > 0) 3856 { 3857 $hit++; 3858 } 3859 } 3860 if ($found > 0) 3861 { 3862 # Store converted entry 3863 set_info_entry($entry, $testdata, $sumcount, $funcdata, 3864 $checkdata, $testfncdata, $sumfnccount, 3865 $testbrdata, $sumbrcount, $found, $hit, 3866 $f_found, $f_hit, $br_found, $br_hit); 3867 } 3868 else 3869 { 3870 # Remove empty data set 3871 delete($trace_data->{$filename}); 3872 } 3873 } 3874 3875 # Convert filenames as well if requested 3876 if ($convert_filenames) 3877 { 3878 convert_paths($trace_data, \%path_conversion_data); 3879 } 3880 3881 info("$converted entr".($converted != 1 ? "ies" : "y")." converted, ". 3882 "$unchanged entr".($unchanged != 1 ? "ies" : "y")." left ". 3883 "unchanged.\n"); 3884 3885 # Write data 3886 if ($to_file) 3887 { 3888 info("Writing data to $output_filename\n"); 3889 open(INFO_HANDLE, ">$output_filename") 3890 or die("ERROR: cannot write to $output_filename!\n"); 3891 @result = write_info_file(*INFO_HANDLE, $trace_data); 3892 close(*INFO_HANDLE); 3893 } 3894 else 3895 { 3896 @result = write_info_file(*STDOUT, $trace_data); 3897 } 3898 3899 return @result; 3900 } 3901 3902 3903 # 3904 # system_no_output(mode, parameters) 3905 # 3906 # Call an external program using PARAMETERS while suppressing depending on 3907 # the value of MODE: 3908 # 3909 # MODE & 1: suppress STDOUT 3910 # MODE & 2: suppress STDERR 3911 # 3912 # Return 0 on success, non-zero otherwise. 3913 # 3914 3915 sub system_no_output($@) 3916 { 3917 my $mode = shift; 3918 my $result; 3919 local *OLD_STDERR; 3920 local *OLD_STDOUT; 3921 3922 # Save old stdout and stderr handles 3923 ($mode & 1) && open(OLD_STDOUT, ">>&STDOUT"); 3924 ($mode & 2) && open(OLD_STDERR, ">>&STDERR"); 3925 3926 # Redirect to /dev/null 3927 ($mode & 1) && open(STDOUT, ">/dev/null"); 3928 ($mode & 2) && open(STDERR, ">/dev/null"); 3929 3930 system(@_); 3931 $result = $?; 3932 3933 # Close redirected handles 3934 ($mode & 1) && close(STDOUT); 3935 ($mode & 2) && close(STDERR); 3936 3937 # Restore old handles 3938 ($mode & 1) && open(STDOUT, ">>&OLD_STDOUT"); 3939 ($mode & 2) && open(STDERR, ">>&OLD_STDERR"); 3940 3941 return $result; 3942 } 3943 3944 3945 # 3946 # read_config(filename) 3947 # 3948 # Read configuration file FILENAME and return a reference to a hash containing 3949 # all valid key=value pairs found. 3950 # 3951 3952 sub read_config($) 3953 { 3954 my $filename = $_[0]; 3955 my %result; 3956 my $key; 3957 my $value; 3958 local *HANDLE; 3959 3960 if (!open(HANDLE, "<$filename")) 3961 { 3962 warn("WARNING: cannot read configuration file $filename\n"); 3963 return undef; 3964 } 3965 while (<HANDLE>) 3966 { 3967 chomp; 3968 # Skip comments 3969 s/#.*//; 3970 # Remove leading blanks 3971 s/^\s+//; 3972 # Remove trailing blanks 3973 s/\s+$//; 3974 next unless length; 3975 ($key, $value) = split(/\s*=\s*/, $_, 2); 3976 if (defined($key) && defined($value)) 3977 { 3978 $result{$key} = $value; 3979 } 3980 else 3981 { 3982 warn("WARNING: malformed statement in line $. ". 3983 "of configuration file $filename\n"); 3984 } 3985 } 3986 close(HANDLE); 3987 return \%result; 3988 } 3989 3990 3991 # 3992 # apply_config(REF) 3993 # 3994 # REF is a reference to a hash containing the following mapping: 3995 # 3996 # key_string => var_ref 3997 # 3998 # where KEY_STRING is a keyword and VAR_REF is a reference to an associated 3999 # variable. If the global configuration hash CONFIG contains a value for 4000 # keyword KEY_STRING, VAR_REF will be assigned the value for that keyword. 4001 # 4002 4003 sub apply_config($) 4004 { 4005 my $ref = $_[0]; 4006 4007 foreach (keys(%{$ref})) 4008 { 4009 if (defined($config->{$_})) 4010 { 4011 ${$ref->{$_}} = $config->{$_}; 4012 } 4013 } 4014 } 4015 4016 sub warn_handler($) 4017 { 4018 my ($msg) = @_; 4019 4020 temp_cleanup(); 4021 warn("$tool_name: $msg"); 4022 } 4023 4024 sub die_handler($) 4025 { 4026 my ($msg) = @_; 4027 4028 temp_cleanup(); 4029 die("$tool_name: $msg"); 4030 } 4031 4032 sub abort_handler($) 4033 { 4034 temp_cleanup(); 4035 exit(1); 4036 } 4037 4038 sub temp_cleanup() 4039 { 4040 if (@temp_dirs) { 4041 info("Removing temporary directories.\n"); 4042 foreach (@temp_dirs) { 4043 rmtree($_); 4044 } 4045 @temp_dirs = (); 4046 } 4047 } 4048 4049 sub setup_gkv_sys() 4050 { 4051 system_no_output(3, "mount", "-t", "debugfs", "nodev", 4052 "/sys/kernel/debug"); 4053 } 4054 4055 sub setup_gkv_proc() 4056 { 4057 if (system_no_output(3, "modprobe", "gcov_proc")) { 4058 system_no_output(3, "modprobe", "gcov_prof"); 4059 } 4060 } 4061 4062 sub check_gkv_sys($) 4063 { 4064 my ($dir) = @_; 4065 4066 if (-e "$dir/reset") { 4067 return 1; 4068 } 4069 return 0; 4070 } 4071 4072 sub check_gkv_proc($) 4073 { 4074 my ($dir) = @_; 4075 4076 if (-e "$dir/vmlinux") { 4077 return 1; 4078 } 4079 return 0; 4080 } 4081 4082 sub setup_gkv() 4083 { 4084 my $dir; 4085 my $sys_dir = "/sys/kernel/debug/gcov"; 4086 my $proc_dir = "/proc/gcov"; 4087 my @todo; 4088 4089 if (!defined($gcov_dir)) { 4090 info("Auto-detecting gcov kernel support.\n"); 4091 @todo = ( "cs", "cp", "ss", "cs", "sp", "cp" ); 4092 } elsif ($gcov_dir =~ /proc/) { 4093 info("Checking gcov kernel support at $gcov_dir ". 4094 "(user-specified).\n"); 4095 @todo = ( "cp", "sp", "cp", "cs", "ss", "cs"); 4096 } else { 4097 info("Checking gcov kernel support at $gcov_dir ". 4098 "(user-specified).\n"); 4099 @todo = ( "cs", "ss", "cs", "cp", "sp", "cp", ); 4100 } 4101 foreach (@todo) { 4102 if ($_ eq "cs") { 4103 # Check /sys 4104 $dir = defined($gcov_dir) ? $gcov_dir : $sys_dir; 4105 if (check_gkv_sys($dir)) { 4106 info("Found ".$GKV_NAME[$GKV_SYS]." gcov ". 4107 "kernel support at $dir\n"); 4108 return ($GKV_SYS, $dir); 4109 } 4110 } elsif ($_ eq "cp") { 4111 # Check /proc 4112 $dir = defined($gcov_dir) ? $gcov_dir : $proc_dir; 4113 if (check_gkv_proc($dir)) { 4114 info("Found ".$GKV_NAME[$GKV_PROC]." gcov ". 4115 "kernel support at $dir\n"); 4116 return ($GKV_PROC, $dir); 4117 } 4118 } elsif ($_ eq "ss") { 4119 # Setup /sys 4120 setup_gkv_sys(); 4121 } elsif ($_ eq "sp") { 4122 # Setup /proc 4123 setup_gkv_proc(); 4124 } 4125 } 4126 if (defined($gcov_dir)) { 4127 die("ERROR: could not find gcov kernel data at $gcov_dir\n"); 4128 } else { 4129 die("ERROR: no gcov kernel data found\n"); 4130 } 4131 } 4132 4133 4134 # 4135 # get_overall_line(found, hit, name_singular, name_plural) 4136 # 4137 # Return a string containing overall information for the specified 4138 # found/hit data. 4139 # 4140 4141 sub get_overall_line($$$$) 4142 { 4143 my ($found, $hit, $name_sn, $name_pl) = @_; 4144 my $name; 4145 4146 return "no data found" if (!defined($found) || $found == 0); 4147 $name = ($found == 1) ? $name_sn : $name_pl; 4148 return sprintf("%.1f%% (%d of %d %s)", $hit * 100 / $found, $hit, 4149 $found, $name); 4150 } 4151 4152 4153 # 4154 # print_overall_rate(ln_do, ln_found, ln_hit, fn_do, fn_found, fn_hit, br_do 4155 # br_found, br_hit) 4156 # 4157 # Print overall coverage rates for the specified coverage types. 4158 # 4159 4160 sub print_overall_rate($$$$$$$$$) 4161 { 4162 my ($ln_do, $ln_found, $ln_hit, $fn_do, $fn_found, $fn_hit, 4163 $br_do, $br_found, $br_hit) = @_; 4164 4165 info("Overall coverage rate:\n"); 4166 info(" lines......: %s\n", 4167 get_overall_line($ln_found, $ln_hit, "line", "lines")) 4168 if ($ln_do); 4169 info(" functions..: %s\n", 4170 get_overall_line($fn_found, $fn_hit, "function", "functions")) 4171 if ($fn_do); 4172 info(" branches...: %s\n", 4173 get_overall_line($br_found, $br_hit, "branch", "branches")) 4174 if ($br_do); 4175 } 4176