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