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@de.ibm.com> 26# 27# 28# History: 29# 2003-08-19 ripped up Peter's script James M Kenefick Jr. <jkenefic@us.ibm.com> 30# 31 32use strict; 33use File::Basename; 34use Getopt::Long; 35# Constants 36our $lcov_version = ""; 37our $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 43our $hi_limit = 50; 44our $med_limit = 15; 45 46# Data related prototypes 47sub print_usage(*); 48sub gen_html(); 49sub process_dir($); 50sub process_file($$$); 51sub info(@); 52sub read_info_file($); 53sub get_info_entry($); 54sub set_info_entry($$$$;$$); 55sub get_prefix(@); 56sub shorten_prefix($); 57sub get_dir_list(@); 58sub get_relative_base_path($); 59sub get_date_string(); 60sub split_filename($); 61sub subtract_counts($$); 62sub add_counts($$); 63sub apply_baseline($$); 64sub combine_info_files($$); 65sub combine_info_entries($$); 66sub apply_prefix($$); 67sub escape_regexp($); 68 69 70# HTML related prototypes 71 72 73sub write_file_table(*$$$$); 74 75 76# Global variables & initialization 77our %info_data; # Hash containing all data from .info file 78our $dir_prefix; # Prefix to remove from all sub directories 79our %test_description; # Hash containing test descriptions if available 80our $date = get_date_string(); 81 82our @info_filenames; # List of .info files to use as data source 83our $test_title; # Title for output as written to each page header 84our $output_directory; # Name of directory in which to store output 85our $base_filename; # Optional name of file containing baseline data 86our $desc_filename; # Name of file containing test descriptions 87our $css_filename; # Optional name of external stylesheet file to use 88our $quiet; # If set, suppress information messages 89our $help; # Help option flag 90our $version; # Version option flag 91our $show_details; # If set, generate detailed directory view 92our $no_prefix; # If set, do not remove filename prefix 93our $frames; # If set, use frames for source code view 94our $keep_descriptions; # If set, do not remove unused test case descriptions 95our $no_sourceview; # If set, do not create a source code view for each file 96our $tab_size = 8; # Number of spaces to use in place of tab 97 98our $cwd = `pwd`; # Current working directory 99chomp($cwd); 100our $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 108if (! ($tool_dir =~ /^\/(.*)$/)) 109{ 110 $tool_dir = "$cwd/$tool_dir"; 111} 112 113# Parse command line options 114if (!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 132if ($help) 133{ 134 print_usage(*STDOUT); 135 exit(0); 136} 137 138# Check for version option 139if ($version) 140{ 141 print($lcov_version."\n"); 142 exit(0); 143} 144 145# Check for info filename 146if (!@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 154if (!$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 169if ($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 177gen_html(); 178 179exit(0); 180 181 182 183# 184# print_usage(handle) 185# 186# Print usage information. 187# 188 189sub print_usage(*) 190{ 191 local *HANDLE = $_[0]; 192 my $executable_name = basename($0); 193 194 print(HANDLE <<END_OF_USAGE); 195Usage: $executable_name [OPTIONS] INFOFILE(S) 196 197Create HTML output for coverage data found in INFOFILE. Note that INFOFILE 198may 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 209See $lcov_url for more information about this tool. 210END_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 226sub 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 321sub 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 386sub 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 439sub 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 625sub 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 645sub 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 666sub 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 728sub 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 744sub 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 766sub 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 793sub 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 811sub 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 841sub 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 882sub 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 896sub 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 940sub 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 990sub 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 1068sub 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 1158sub 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 1192sub 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 1217sub 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