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 |