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