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