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