| OLD | NEW |
| (Empty) |
| 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.co
m> | |
| 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 = "Non
e"; } | |
| 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 } | |
| OLD | NEW |