1 #!/usr/bin/perl -w 2 # 3 # Copyright (c) International Business Machines Corp., 2002 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 # genflat 21 # 22 # This script generates std output from .info files as created by the 23 # geninfo script. Call it with --help to get information on usage and 24 # available options. This code is based on the lcov genhtml script 25 # by Peter Oberparleiter <Peter.Oberparleiter (at] de.ibm.com> 26 # 27 # 28 # History: 29 # 2003-08-19 ripped up Peter's script James M Kenefick Jr. <jkenefic (at] us.ibm.com> 30 # 31 32 use strict; 33 use File::Basename; 34 use Getopt::Long; 35 # Constants 36 our $lcov_version = ""; 37 our $lcov_url = ""; 38 39 # Specify coverage rate limits (in %) for classifying file entries 40 # HI: $hi_limit <= rate <= 100 graph color: green 41 # MED: $med_limit <= rate < $hi_limit graph color: orange 42 # LO: 0 <= rate < $med_limit graph color: red 43 our $hi_limit = 50; 44 our $med_limit = 15; 45 46 # Data related prototypes 47 sub print_usage(*); 48 sub gen_html(); 49 sub process_dir($); 50 sub process_file($$$); 51 sub info(@); 52 sub read_info_file($); 53 sub get_info_entry($); 54 sub set_info_entry($$$$;$$); 55 sub get_prefix(@); 56 sub shorten_prefix($); 57 sub get_dir_list(@); 58 sub get_relative_base_path($); 59 sub get_date_string(); 60 sub split_filename($); 61 sub subtract_counts($$); 62 sub add_counts($$); 63 sub apply_baseline($$); 64 sub combine_info_files($$); 65 sub combine_info_entries($$); 66 sub apply_prefix($$); 67 sub escape_regexp($); 68 69 70 # HTML related prototypes 71 72 73 sub write_file_table(*$$$$); 74 75 76 # Global variables & initialization 77 our %info_data; # Hash containing all data from .info file 78 our $dir_prefix; # Prefix to remove from all sub directories 79 our %test_description; # Hash containing test descriptions if available 80 our $date = get_date_string(); 81 82 our @info_filenames; # List of .info files to use as data source 83 our $test_title; # Title for output as written to each page header 84 our $output_directory; # Name of directory in which to store output 85 our $base_filename; # Optional name of file containing baseline data 86 our $desc_filename; # Name of file containing test descriptions 87 our $css_filename; # Optional name of external stylesheet file to use 88 our $quiet; # If set, suppress information messages 89 our $help; # Help option flag 90 our $version; # Version option flag 91 our $show_details; # If set, generate detailed directory view 92 our $no_prefix; # If set, do not remove filename prefix 93 our $frames; # If set, use frames for source code view 94 our $keep_descriptions; # If set, do not remove unused test case descriptions 95 our $no_sourceview; # If set, do not create a source code view for each file 96 our $tab_size = 8; # Number of spaces to use in place of tab 97 98 our $cwd = `pwd`; # Current working directory 99 chomp($cwd); 100 our $tool_dir = dirname($0); # Directory where genhtml tool is installed 101 102 103 # 104 # Code entry point 105 # 106 107 # Add current working directory if $tool_dir is not already an absolute path 108 if (! ($tool_dir =~ /^\/(.*)$/)) 109 { 110 $tool_dir = "$cwd/$tool_dir"; 111 } 112 113 # Parse command line options 114 if (!GetOptions("output-directory=s" => \$output_directory, 115 "css-file=s" => \$css_filename, 116 "baseline-file=s" => \$base_filename, 117 "prefix=s" => \$dir_prefix, 118 "num-spaces=i" => \$tab_size, 119 "no-prefix" => \$no_prefix, 120 "quiet" => \$quiet, 121 "help" => \$help, 122 "version" => \$version 123 )) 124 { 125 print_usage(*STDERR); 126 exit(1); 127 } 128 129 @info_filenames = @ARGV; 130 131 # Check for help option 132 if ($help) 133 { 134 print_usage(*STDOUT); 135 exit(0); 136 } 137 138 # Check for version option 139 if ($version) 140 { 141 print($lcov_version."\n"); 142 exit(0); 143 } 144 145 # Check for info filename 146 if (!@info_filenames) 147 { 148 print(STDERR "No filename specified\n"); 149 print_usage(*STDERR); 150 exit(1); 151 } 152 153 # Generate a title if none is specified 154 if (!$test_title) 155 { 156 if (scalar(@info_filenames) == 1) 157 { 158 # Only one filename specified, use it as title 159 $test_title = basename($info_filenames[0]); 160 } 161 else 162 { 163 # More than one filename specified, used default title 164 $test_title = "unnamed"; 165 } 166 } 167 168 # Make sure tab_size is within valid range 169 if ($tab_size < 1) 170 { 171 print(STDERR "ERROR: invalid number of spaces specified: ". 172 "$tab_size!\n"); 173 exit(1); 174 } 175 176 # Do something 177 gen_html(); 178 179 exit(0); 180 181 182 183 # 184 # print_usage(handle) 185 # 186 # Print usage information. 187 # 188 189 sub print_usage(*) 190 { 191 local *HANDLE = $_[0]; 192 my $executable_name = basename($0); 193 194 print(HANDLE <<END_OF_USAGE); 195 Usage: $executable_name [OPTIONS] INFOFILE(S) 196 197 Create HTML output for coverage data found in INFOFILE. Note that INFOFILE 198 may also be a list of filenames. 199 200 -h, --help Print this help, then exit 201 -v, --version Print version number, then exit 202 -q, --quiet Do not print progress messages 203 -b, --baseline-file BASEFILE Use BASEFILE as baseline file 204 -p, --prefix PREFIX Remove PREFIX from all directory names 205 --no-prefix Do not remove prefix from directory names 206 --no-source Do not create source code view 207 --num-spaces NUM Replace tabs with NUM spaces in source view 208 209 See $lcov_url for more information about this tool. 210 END_OF_USAGE 211 ; 212 } 213 214 215 # 216 # gen_html() 217 # 218 # Generate a set of HTML pages from contents of .info file INFO_FILENAME. 219 # Files will be written to the current directory. If provided, test case 220 # descriptions will be read from .tests file TEST_FILENAME and included 221 # in ouput. 222 # 223 # Die on error. 224 # 225 226 sub gen_html() 227 { 228 local *HTML_HANDLE; 229 my %overview; 230 my %base_data; 231 my $lines_found; 232 my $lines_hit; 233 my $overall_found = 0; 234 my $overall_hit = 0; 235 my $dir_name; 236 my $link_name; 237 my @dir_list; 238 my %new_info; 239 240 # Read in all specified .info files 241 foreach (@info_filenames) 242 { 243 info("Reading data file $_\n"); 244 %new_info = %{read_info_file($_)}; 245 246 # Combine %new_info with %info_data 247 %info_data = %{combine_info_files(\%info_data, \%new_info)}; 248 } 249 250 info("Found %d entries.\n", scalar(keys(%info_data))); 251 252 # Read and apply baseline data if specified 253 if ($base_filename) 254 { 255 # Read baseline file 256 info("Reading baseline file $base_filename\n"); 257 %base_data = %{read_info_file($base_filename)}; 258 info("Found %d entries.\n", scalar(keys(%base_data))); 259 260 # Apply baseline 261 info("Subtracting baseline data.\n"); 262 %info_data = %{apply_baseline(\%info_data, \%base_data)}; 263 } 264 265 @dir_list = get_dir_list(keys(%info_data)); 266 267 if ($no_prefix) 268 { 269 # User requested that we leave filenames alone 270 info("User asked not to remove filename prefix\n"); 271 } 272 elsif (!defined($dir_prefix)) 273 { 274 # Get prefix common to most directories in list 275 $dir_prefix = get_prefix(@dir_list); 276 277 if ($dir_prefix) 278 { 279 info("Found common filename prefix \"$dir_prefix\"\n"); 280 } 281 else 282 { 283 info("No common filename prefix found!\n"); 284 $no_prefix=1; 285 } 286 } 287 else 288 { 289 info("Using user-specified filename prefix \"". 290 "$dir_prefix\"\n"); 291 } 292 293 # Process each subdirectory and collect overview information 294 foreach $dir_name (@dir_list) 295 { 296 ($lines_found, $lines_hit) = process_dir($dir_name); 297 298 $overview{$dir_name} = "$lines_found,$lines_hit, "; 299 $overall_found += $lines_found; 300 $overall_hit += $lines_hit; 301 } 302 303 304 if ($overall_found == 0) 305 { 306 info("Warning: No lines found!\n"); 307 } 308 else 309 { 310 info("Overall coverage rate: %d of %d lines (%.1f%%)\n", 311 $overall_hit, $overall_found, 312 $overall_hit*100/$overall_found); 313 } 314 } 315 316 317 # 318 # process_dir(dir_name) 319 # 320 321 sub process_dir($) 322 { 323 my $abs_dir = $_[0]; 324 my $trunc_dir; 325 my $rel_dir = $abs_dir; 326 my $base_dir; 327 my $filename; 328 my %overview; 329 my $lines_found; 330 my $lines_hit; 331 my $overall_found=0; 332 my $overall_hit=0; 333 my $base_name; 334 my $extension; 335 my $testdata; 336 my %testhash; 337 local *HTML_HANDLE; 338 339 # Remove prefix if applicable 340 if (!$no_prefix) 341 { 342 # Match directory name beginning with $dir_prefix 343 $rel_dir = apply_prefix($rel_dir, $dir_prefix); 344 } 345 346 $trunc_dir = $rel_dir; 347 348 # Remove leading / 349 if ($rel_dir =~ /^\/(.*)$/) 350 { 351 $rel_dir = substr($rel_dir, 1); 352 } 353 354 $base_dir = get_relative_base_path($rel_dir); 355 356 $abs_dir = escape_regexp($abs_dir); 357 358 # Match filenames which specify files in this directory, not including 359 # sub-directories 360 foreach $filename (grep(/^$abs_dir\/[^\/]*$/,keys(%info_data))) 361 { 362 ($lines_found, $lines_hit, $testdata) = 363 process_file($trunc_dir, $rel_dir, $filename); 364 365 $base_name = basename($filename); 366 367 $overview{$base_name} = "$lines_found,$lines_hit"; 368 369 $testhash{$base_name} = $testdata; 370 371 $overall_found += $lines_found; 372 $overall_hit += $lines_hit; 373 } 374 write_file_table($abs_dir, "./linux/", \%overview, \%testhash, 4); 375 376 377 # Calculate resulting line counts 378 return ($overall_found, $overall_hit); 379 } 380 381 382 # 383 # process_file(trunc_dir, rel_dir, filename) 384 # 385 386 sub process_file($$$) 387 { 388 info("Processing file ".apply_prefix($_[2], $dir_prefix)."\n"); 389 my $trunc_dir = $_[0]; 390 my $rel_dir = $_[1]; 391 my $filename = $_[2]; 392 my $base_name = basename($filename); 393 my $base_dir = get_relative_base_path($rel_dir); 394 my $testdata; 395 my $testcount; 396 my $sumcount; 397 my $funcdata; 398 my $lines_found; 399 my $lines_hit; 400 my @source; 401 my $pagetitle; 402 403 ($testdata, $sumcount, $funcdata, $lines_found, $lines_hit) = 404 get_info_entry($info_data{$filename}); 405 return ($lines_found, $lines_hit, $testdata); 406 } 407 408 409 # 410 # read_info_file(info_filename) 411 # 412 # Read in the contents of the .info file specified by INFO_FILENAME. Data will 413 # be returned as a reference to a hash containing the following mappings: 414 # 415 # %result: for each filename found in file -> \%data 416 # 417 # %data: "test" -> \%testdata 418 # "sum" -> \%sumcount 419 # "func" -> \%funcdata 420 # "found" -> $lines_found (number of instrumented lines found in file) 421 # "hit" -> $lines_hit (number of executed lines in file) 422 # 423 # %testdata: name of test affecting this file -> \%testcount 424 # 425 # %testcount: line number -> execution count for a single test 426 # %sumcount : line number -> execution count for all tests 427 # %funcdata : line number -> name of function beginning at that line 428 # 429 # Note that .info file sections referring to the same file and test name 430 # will automatically be combined by adding all execution counts. 431 # 432 # Note that if INFO_FILENAME ends with ".gz", it is assumed that the file 433 # is compressed using GZIP. If available, GUNZIP will be used to decompress 434 # this file. 435 # 436 # Die on error 437 # 438 439 sub read_info_file($) 440 { 441 my $tracefile = $_[0]; # Name of tracefile 442 my %result; # Resulting hash: file -> data 443 my $data; # Data handle for current entry 444 my $testdata; # " " 445 my $testcount; # " " 446 my $sumcount; # " " 447 my $funcdata; # " " 448 my $line; # Current line read from .info file 449 my $testname; # Current test name 450 my $filename; # Current filename 451 my $hitcount; # Count for lines hit 452 my $count; # Execution count of current line 453 my $negative; # If set, warn about negative counts 454 local *INFO_HANDLE; # Filehandle for .info file 455 456 # Check if file exists and is readable 457 stat($_[0]); 458 if (!(-r _)) 459 { 460 die("ERROR: cannot read file $_[0]!\n"); 461 } 462 463 # Check if this is really a plain file 464 if (!(-f _)) 465 { 466 die("ERROR: not a plain file: $_[0]!\n"); 467 } 468 469 # Check for .gz extension 470 if ($_[0] =~ /^(.*)\.gz$/) 471 { 472 # Check for availability of GZIP tool 473 system("gunzip -h >/dev/null 2>/dev/null") 474 and die("ERROR: gunzip command not available!\n"); 475 476 # Check integrity of compressed file 477 system("gunzip -t $_[0] >/dev/null 2>/dev/null") 478 and die("ERROR: integrity check failed for ". 479 "compressed file $_[0]!\n"); 480 481 # Open compressed file 482 open(INFO_HANDLE, "gunzip -c $_[0]|") 483 or die("ERROR: cannot start gunzip to uncompress ". 484 "file $_[0]!\n"); 485 } 486 else 487 { 488 # Open uncompressed file 489 open(INFO_HANDLE, $_[0]) 490 or die("ERROR: cannot read file $_[0]!\n"); 491 } 492 493 $testname = ""; 494 while (<INFO_HANDLE>) 495 { 496 chomp($_); 497 $line = $_; 498 499 # Switch statement 500 foreach ($line) 501 { 502 /^TN:(\w+)/ && do 503 { 504 # Test name information found 505 $testname = $1; 506 last; 507 }; 508 509 /^[SK]F:(.*)/ && do 510 { 511 # Filename information found 512 # Retrieve data for new entry 513 $filename = $1; 514 515 $data = $result{$filename}; 516 ($testdata, $sumcount, $funcdata) = 517 get_info_entry($data); 518 519 if (defined($testname)) 520 { 521 $testcount = $testdata->{$testname}; 522 } 523 else 524 { 525 my %new_hash; 526 $testcount = \%new_hash; 527 } 528 last; 529 }; 530 531 /^DA:(\d+),(-?\d+)/ && do 532 { 533 # Fix negative counts 534 $count = $2 < 0 ? 0 : $2; 535 if ($2 < 0) 536 { 537 $negative = 1; 538 } 539 # Execution count found, add to structure 540 # Add summary counts 541 $sumcount->{$1} += $count; 542 543 # Add test-specific counts 544 if (defined($testname)) 545 { 546 $testcount->{$1} += $count; 547 } 548 last; 549 }; 550 551 /^FN:(\d+),([^,]+)/ && do 552 { 553 # Function data found, add to structure 554 $funcdata->{$1} = $2; 555 last; 556 }; 557 558 /^end_of_record/ && do 559 { 560 # Found end of section marker 561 if ($filename) 562 { 563 # Store current section data 564 if (defined($testname)) 565 { 566 $testdata->{$testname} = 567 $testcount; 568 } 569 set_info_entry($data, $testdata, 570 $sumcount, $funcdata); 571 $result{$filename} = $data; 572 } 573 574 }; 575 576 # default 577 last; 578 } 579 } 580 close(INFO_HANDLE); 581 582 # Calculate lines_found and lines_hit for each file 583 foreach $filename (keys(%result)) 584 { 585 $data = $result{$filename}; 586 587 ($testdata, $sumcount, $funcdata) = get_info_entry($data); 588 589 $data->{"found"} = scalar(keys(%{$sumcount})); 590 $hitcount = 0; 591 592 foreach (keys(%{$sumcount})) 593 { 594 if ($sumcount->{$_} >0) { $hitcount++; } 595 } 596 597 $data->{"hit"} = $hitcount; 598 599 $result{$filename} = $data; 600 } 601 602 if (scalar(keys(%result)) == 0) 603 { 604 die("ERROR: No valid records found in tracefile $tracefile\n"); 605 } 606 if ($negative) 607 { 608 warn("WARNING: Negative counts found in tracefile ". 609 "$tracefile\n"); 610 } 611 612 return(\%result); 613 } 614 615 616 # 617 # get_info_entry(hash_ref) 618 # 619 # Retrieve data from an entry of the structure generated by read_info_file(). 620 # Return a list of references to hashes: 621 # (test data hash ref, sum count hash ref, funcdata hash ref, lines found, 622 # lines hit) 623 # 624 625 sub get_info_entry($) 626 { 627 my $testdata_ref = $_[0]->{"test"}; 628 my $sumcount_ref = $_[0]->{"sum"}; 629 my $funcdata_ref = $_[0]->{"func"}; 630 my $lines_found = $_[0]->{"found"}; 631 my $lines_hit = $_[0]->{"hit"}; 632 633 return ($testdata_ref, $sumcount_ref, $funcdata_ref, $lines_found, 634 $lines_hit); 635 } 636 637 638 # 639 # set_info_entry(hash_ref, testdata_ref, sumcount_ref, funcdata_ref[, 640 # lines_found, lines_hit]) 641 # 642 # Update the hash referenced by HASH_REF with the provided data references. 643 # 644 645 sub set_info_entry($$$$;$$) 646 { 647 my $data_ref = $_[0]; 648 649 $data_ref->{"test"} = $_[1]; 650 $data_ref->{"sum"} = $_[2]; 651 $data_ref->{"func"} = $_[3]; 652 653 if (defined($_[4])) { $data_ref->{"found"} = $_[4]; } 654 if (defined($_[5])) { $data_ref->{"hit"} = $_[5]; } 655 } 656 657 658 # 659 # get_prefix(filename_list) 660 # 661 # Search FILENAME_LIST for a directory prefix which is common to as many 662 # list entries as possible, so that removing this prefix will minimize the 663 # sum of the lengths of all resulting shortened filenames. 664 # 665 666 sub get_prefix(@) 667 { 668 my @filename_list = @_; # provided list of filenames 669 my %prefix; # mapping: prefix -> sum of lengths 670 my $current; # Temporary iteration variable 671 672 # Find list of prefixes 673 foreach (@filename_list) 674 { 675 # Need explicit assignment to get a copy of $_ so that 676 # shortening the contained prefix does not affect the list 677 $current = shorten_prefix($_); 678 while ($current = shorten_prefix($current)) 679 { 680 # Skip rest if the remaining prefix has already been 681 # added to hash 682 if ($prefix{$current}) { last; } 683 684 # Initialize with 0 685 $prefix{$current}="0"; 686 } 687 688 } 689 690 # Calculate sum of lengths for all prefixes 691 foreach $current (keys(%prefix)) 692 { 693 foreach (@filename_list) 694 { 695 # Add original length 696 $prefix{$current} += length($_); 697 698 # Check whether prefix matches 699 if (substr($_, 0, length($current)) eq $current) 700 { 701 # Subtract prefix length for this filename 702 $prefix{$current} -= length($current); 703 } 704 } 705 } 706 707 # Find and return prefix with minimal sum 708 $current = (keys(%prefix))[0]; 709 710 foreach (keys(%prefix)) 711 { 712 if ($prefix{$_} < $prefix{$current}) 713 { 714 $current = $_; 715 } 716 } 717 718 return($current); 719 } 720 721 722 # 723 # shorten_prefix(prefix) 724 # 725 # Return PREFIX shortened by last directory component. 726 # 727 728 sub shorten_prefix($) 729 { 730 my @list = split("/", $_[0]); 731 732 pop(@list); 733 return join("/", @list); 734 } 735 736 737 738 # 739 # get_dir_list(filename_list) 740 # 741 # Return sorted list of directories for each entry in given FILENAME_LIST. 742 # 743 744 sub get_dir_list(@) 745 { 746 my %result; 747 748 foreach (@_) 749 { 750 $result{shorten_prefix($_)} = ""; 751 } 752 753 return(sort(keys(%result))); 754 } 755 756 757 # 758 # get_relative_base_path(subdirectory) 759 # 760 # Return a relative path string which references the base path when applied 761 # in SUBDIRECTORY. 762 # 763 # Example: get_relative_base_path("fs/mm") -> "../../" 764 # 765 766 sub get_relative_base_path($) 767 { 768 my $result = ""; 769 my $index; 770 771 # Make an empty directory path a special case 772 if (!$_[0]) { return(""); } 773 774 # Count number of /s in path 775 $index = ($_[0] =~ s/\//\//g); 776 777 # Add a ../ to $result for each / in the directory path + 1 778 for (; $index>=0; $index--) 779 { 780 $result .= "../"; 781 } 782 783 return $result; 784 } 785 786 787 # 788 # get_date_string() 789 # 790 # Return the current date in the form: yyyy-mm-dd 791 # 792 793 sub get_date_string() 794 { 795 my $year; 796 my $month; 797 my $day; 798 799 ($year, $month, $day) = (localtime())[5, 4, 3]; 800 801 return sprintf("%d-%02d-%02d", $year+1900, $month+1, $day); 802 } 803 804 805 # 806 # split_filename(filename) 807 # 808 # Return (path, filename, extension) for a given FILENAME. 809 # 810 811 sub split_filename($) 812 { 813 if (!$_[0]) { return(); } 814 my @path_components = split('/', $_[0]); 815 my @file_components = split('\.', pop(@path_components)); 816 my $extension = pop(@file_components); 817 818 return (join("/",@path_components), join(".",@file_components), 819 $extension); 820 } 821 822 823 # 824 # write_file_table(filehandle, base_dir, overview, testhash, fileview) 825 # 826 # Write a complete file table. OVERVIEW is a reference to a hash containing 827 # the following mapping: 828 # 829 # filename -> "lines_found,lines_hit,page_link" 830 # 831 # TESTHASH is a reference to the following hash: 832 # 833 # filename -> \%testdata 834 # %testdata: name of test affecting this file -> \%testcount 835 # %testcount: line number -> execution count for a single test 836 # 837 # Heading of first column is "Filename" if FILEVIEW is true, "Directory name" 838 # otherwise. 839 # 840 841 sub write_file_table(*$$$$) 842 { 843 my $dir = $_[0]; 844 my $base_dir = $_[1]; 845 my %overview = %{$_[2]}; 846 my %testhash = %{$_[3]}; 847 my $fileview = $_[4]; 848 my $filename; 849 my $hit; 850 my $found; 851 my $classification; 852 my $rate_string; 853 my $rate; 854 my $junk; 855 856 857 foreach $filename (sort(keys(%overview))) 858 { 859 ($found, $hit, $junk) = split(",", $overview{$filename}); 860 #James I think this is right 861 $rate = $hit * 100 / $found; 862 $rate_string = sprintf("%.1f", $rate); 863 864 if ($rate < 0.001) { $classification = "None"; } 865 elsif ($rate < $med_limit) { $classification = "Lo"; } 866 elsif ($rate < $hi_limit) { $classification = "Med"; } 867 else { $classification = "Hi"; } 868 869 print "$dir/$filename\t$classification\t$rate_string\n"; 870 871 } 872 } 873 874 875 # 876 # info(printf_parameter) 877 # 878 # Use printf to write PRINTF_PARAMETER to stdout only when the $quiet flag 879 # is not set. 880 # 881 882 sub info(@) 883 { 884 if (!$quiet) 885 { 886 # Print info string 887 printf(STDERR @_); 888 } 889 } 890 891 892 # 893 # subtract_counts(data_ref, base_ref) 894 # 895 896 sub subtract_counts($$) 897 { 898 my %data = %{$_[0]}; 899 my %base = %{$_[1]}; 900 my $line; 901 my $data_count; 902 my $base_count; 903 my $hit = 0; 904 my $found = 0; 905 906 foreach $line (keys(%data)) 907 { 908 $found++; 909 $data_count = $data{$line}; 910 $base_count = $base{$line}; 911 912 if (defined($base_count)) 913 { 914 $data_count -= $base_count; 915 916 # Make sure we don't get negative numbers 917 if ($data_count<0) { $data_count = 0; } 918 } 919 920 $data{$line} = $data_count; 921 if ($data_count > 0) { $hit++; } 922 } 923 924 return (\%data, $found, $hit); 925 } 926 927 928 # 929 # add_counts(data1_ref, data2_ref) 930 # 931 # DATA1_REF and DATA2_REF are references to hashes containing a mapping 932 # 933 # line number -> execution count 934 # 935 # Return a list (RESULT_REF, LINES_FOUND, LINES_HIT) where RESULT_REF 936 # is a reference to a hash containing the combined mapping in which 937 # execution counts are added. 938 # 939 940 sub add_counts($$) 941 { 942 my %data1 = %{$_[0]}; # Hash 1 943 my %data2 = %{$_[1]}; # Hash 2 944 my %result; # Resulting hash 945 my $line; # Current line iteration scalar 946 my $data1_count; # Count of line in hash1 947 my $data2_count; # Count of line in hash2 948 my $found = 0; # Total number of lines found 949 my $hit = 0; # Number of lines with a count > 0 950 951 foreach $line (keys(%data1)) 952 { 953 $data1_count = $data1{$line}; 954 $data2_count = $data2{$line}; 955 956 # Add counts if present in both hashes 957 if (defined($data2_count)) { $data1_count += $data2_count; } 958 959 # Store sum in %result 960 $result{$line} = $data1_count; 961 962 $found++; 963 if ($data1_count > 0) { $hit++; } 964 } 965 966 # Add lines unique to data2 967 foreach $line (keys(%data2)) 968 { 969 # Skip lines already in data1 970 if (defined($data1{$line})) { next; } 971 972 # Copy count from data2 973 $result{$line} = $data2{$line}; 974 975 $found++; 976 if ($result{$line} > 0) { $hit++; } 977 } 978 979 return (\%result, $found, $hit); 980 } 981 982 983 # 984 # apply_baseline(data_ref, baseline_ref) 985 # 986 # Subtract the execution counts found in the baseline hash referenced by 987 # BASELINE_REF from actual data in DATA_REF. 988 # 989 990 sub apply_baseline($$) 991 { 992 my %data_hash = %{$_[0]}; 993 my %base_hash = %{$_[1]}; 994 my $filename; 995 my $testname; 996 my $data; 997 my $data_testdata; 998 my $data_funcdata; 999 my $data_count; 1000 my $base; 1001 my $base_testdata; 1002 my $base_count; 1003 my $sumcount; 1004 my $found; 1005 my $hit; 1006 1007 foreach $filename (keys(%data_hash)) 1008 { 1009 # Get data set for data and baseline 1010 $data = $data_hash{$filename}; 1011 $base = $base_hash{$filename}; 1012 1013 # Get set entries for data and baseline 1014 ($data_testdata, undef, $data_funcdata) = 1015 get_info_entry($data); 1016 ($base_testdata, $base_count) = get_info_entry($base); 1017 1018 # Sumcount has to be calculated anew 1019 $sumcount = {}; 1020 1021 # For each test case, subtract test specific counts 1022 foreach $testname (keys(%{$data_testdata})) 1023 { 1024 # Get counts of both data and baseline 1025 $data_count = $data_testdata->{$testname}; 1026 1027 $hit = 0; 1028 1029 ($data_count, undef, $hit) = 1030 subtract_counts($data_count, $base_count); 1031 1032 # Check whether this test case did hit any line at all 1033 if ($hit > 0) 1034 { 1035 # Write back resulting hash 1036 $data_testdata->{$testname} = $data_count; 1037 } 1038 else 1039 { 1040 # Delete test case which did not impact this 1041 # file 1042 delete($data_testdata->{$testname}); 1043 } 1044 1045 # Add counts to sum of counts 1046 ($sumcount, $found, $hit) = 1047 add_counts($sumcount, $data_count); 1048 } 1049 1050 # Write back resulting entry 1051 set_info_entry($data, $data_testdata, $sumcount, 1052 $data_funcdata, $found, $hit); 1053 1054 $data_hash{$filename} = $data; 1055 } 1056 1057 return (\%data_hash); 1058 } 1059 1060 1061 # 1062 # combine_info_entries(entry_ref1, entry_ref2) 1063 # 1064 # Combine .info data entry hashes referenced by ENTRY_REF1 and ENTRY_REF2. 1065 # Return reference to resulting hash. 1066 # 1067 1068 sub combine_info_entries($$) 1069 { 1070 my $entry1 = $_[0]; # Reference to hash containing first entry 1071 my $testdata1; 1072 my $sumcount1; 1073 my $funcdata1; 1074 1075 my $entry2 = $_[1]; # Reference to hash containing second entry 1076 my $testdata2; 1077 my $sumcount2; 1078 my $funcdata2; 1079 1080 my %result; # Hash containing combined entry 1081 my %result_testdata; 1082 my $result_sumcount = {}; 1083 my %result_funcdata; 1084 my $lines_found; 1085 my $lines_hit; 1086 1087 my $testname; 1088 1089 # Retrieve data 1090 ($testdata1, $sumcount1, $funcdata1) = get_info_entry($entry1); 1091 ($testdata2, $sumcount2, $funcdata2) = get_info_entry($entry2); 1092 1093 # Combine funcdata 1094 foreach (keys(%{$funcdata1})) 1095 { 1096 $result_funcdata{$_} = $funcdata1->{$_}; 1097 } 1098 1099 foreach (keys(%{$funcdata2})) 1100 { 1101 $result_funcdata{$_} = $funcdata2->{$_}; 1102 } 1103 1104 # Combine testdata 1105 foreach $testname (keys(%{$testdata1})) 1106 { 1107 if (defined($testdata2->{$testname})) 1108 { 1109 # testname is present in both entries, requires 1110 # combination 1111 ($result_testdata{$testname}) = 1112 add_counts($testdata1->{$testname}, 1113 $testdata2->{$testname}); 1114 } 1115 else 1116 { 1117 # testname only present in entry1, add to result 1118 $result_testdata{$testname} = $testdata1->{$testname}; 1119 } 1120 1121 # update sum count hash 1122 ($result_sumcount, $lines_found, $lines_hit) = 1123 add_counts($result_sumcount, 1124 $result_testdata{$testname}); 1125 } 1126 1127 foreach $testname (keys(%{$testdata2})) 1128 { 1129 # Skip testnames already covered by previous iteration 1130 if (defined($testdata1->{$testname})) { next; } 1131 1132 # testname only present in entry2, add to result hash 1133 $result_testdata{$testname} = $testdata2->{$testname}; 1134 1135 # update sum count hash 1136 ($result_sumcount, $lines_found, $lines_hit) = 1137 add_counts($result_sumcount, 1138 $result_testdata{$testname}); 1139 } 1140 1141 # Calculate resulting sumcount 1142 1143 # Store result 1144 set_info_entry(\%result, \%result_testdata, $result_sumcount, 1145 \%result_funcdata, $lines_found, $lines_hit); 1146 1147 return(\%result); 1148 } 1149 1150 1151 # 1152 # combine_info_files(info_ref1, info_ref2) 1153 # 1154 # Combine .info data in hashes referenced by INFO_REF1 and INFO_REF2. Return 1155 # reference to resulting hash. 1156 # 1157 1158 sub combine_info_files($$) 1159 { 1160 my %hash1 = %{$_[0]}; 1161 my %hash2 = %{$_[1]}; 1162 my $filename; 1163 1164 foreach $filename (keys(%hash2)) 1165 { 1166 if ($hash1{$filename}) 1167 { 1168 # Entry already exists in hash1, combine them 1169 $hash1{$filename} = 1170 combine_info_entries($hash1{$filename}, 1171 $hash2{$filename}); 1172 } 1173 else 1174 { 1175 # Entry is unique in both hashes, simply add to 1176 # resulting hash 1177 $hash1{$filename} = $hash2{$filename}; 1178 } 1179 } 1180 1181 return(\%hash1); 1182 } 1183 1184 1185 # 1186 # apply_prefix(filename, prefix) 1187 # 1188 # If FILENAME begins with PREFIX, remove PREFIX from FILENAME and return 1189 # resulting string, otherwise return FILENAME. 1190 # 1191 1192 sub apply_prefix($$) 1193 { 1194 my $filename = $_[0]; 1195 my $prefix = $_[1]; 1196 my $clean_prefix = escape_regexp($prefix); 1197 1198 if (defined($prefix) && ($prefix ne "")) 1199 { 1200 if ($filename =~ /^$clean_prefix\/(.*)$/) 1201 { 1202 return substr($filename, length($prefix) + 1); 1203 } 1204 } 1205 1206 return $filename; 1207 } 1208 1209 1210 # 1211 # escape_regexp(string) 1212 # 1213 # Escape special characters in STRING which would be incorrectly interpreted 1214 # in a PERL regular expression. 1215 # 1216 1217 sub escape_regexp($) 1218 { 1219 my $string = $_[0]; 1220 1221 # Escape special characters 1222 $string =~ s/\\/\\\\/g; 1223 $string =~ s/\^/\\\^/g; 1224 $string =~ s/\$/\\\$/g; 1225 $string =~ s/\./\\\./g; 1226 $string =~ s/\|/\\\|/g; 1227 $string =~ s/\(/\\\(/g; 1228 $string =~ s/\)/\\\)/g; 1229 $string =~ s/\[/\\\[/g; 1230 $string =~ s/\]/\\\]/g; 1231 $string =~ s/\*/\\\*/g; 1232 $string =~ s/\?/\\\?/g; 1233 $string =~ s/\{/\\\{/g; 1234 $string =~ s/\}/\\\}/g; 1235 $string =~ s/\+/\\\+/g; 1236 1237 return $string; 1238 } 1239
