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 # geninfo | |
21 # | |
22 # This script generates .info files from data files as created by code | |
23 # instrumented with gcc's built-in profiling mechanism. Call it with | |
24 # --help and refer to the geninfo man page to get information on usage | |
25 # and available options. | |
26 # | |
27 # | |
28 # Authors: | |
29 # 2002-08-23 created by Peter Oberparleiter <Peter.Oberparleiter@de.ibm.com> | |
30 # IBM Lab Boeblingen | |
31 # based on code by Manoj Iyer <manjo@mail.utexas.edu> and | |
32 # Megan Bock <mbock@us.ibm.com> | |
33 # IBM Austin | |
34 # 2002-09-05 / Peter Oberparleiter: implemented option that allows file list | |
35 # 2003-04-16 / Peter Oberparleiter: modified read_gcov so that it can also | |
36 # parse the new gcov format which is to be introduced in gcc 3.3 | |
37 # 2003-04-30 / Peter Oberparleiter: made info write to STDERR, not STDOUT | |
38 # 2003-07-03 / Peter Oberparleiter: added line checksum support, added | |
39 # --no-checksum | |
40 # 2003-09-18 / Nigel Hinds: capture branch coverage data from GCOV | |
41 # 2003-12-11 / Laurent Deniel: added --follow option | |
42 # workaround gcov (<= 3.2.x) bug with empty .da files | |
43 # 2004-01-03 / Laurent Deniel: Ignore empty .bb files | |
44 # 2004-02-16 / Andreas Krebbel: Added support for .gcno/.gcda files and | |
45 # gcov versioning | |
46 # 2004-08-09 / Peter Oberparleiter: added configuration file support | |
47 # 2008-07-14 / Tom Zoerner: added --function-coverage command line option | |
48 # 2008-08-13 / Peter Oberparleiter: modified function coverage | |
49 # implementation (now enabled per default) | |
50 # | |
51 | |
52 use strict; | |
53 use File::Basename; | |
54 use File::Spec::Functions qw /abs2rel catdir file_name_is_absolute splitdir | |
55 splitpath/; | |
56 use Getopt::Long; | |
57 use Digest::MD5 qw(md5_base64); | |
58 | |
59 | |
60 # Constants | |
61 our $lcov_version = 'LCOV version 1.9'; | |
62 our $lcov_url = "http://ltp.sourceforge.net/coverage/lcov.php"; | |
63 our $gcov_tool = "gcov"; | |
64 our $tool_name = basename($0); | |
65 | |
66 our $GCOV_VERSION_3_4_0 = 0x30400; | |
67 our $GCOV_VERSION_3_3_0 = 0x30300; | |
68 our $GCNO_FUNCTION_TAG = 0x01000000; | |
69 our $GCNO_LINES_TAG = 0x01450000; | |
70 our $GCNO_FILE_MAGIC = 0x67636e6f; | |
71 our $BBG_FILE_MAGIC = 0x67626267; | |
72 | |
73 our $COMPAT_HAMMER = "hammer"; | |
74 | |
75 our $ERROR_GCOV = 0; | |
76 our $ERROR_SOURCE = 1; | |
77 our $ERROR_GRAPH = 2; | |
78 | |
79 our $EXCL_START = "LCOV_EXCL_START"; | |
80 our $EXCL_STOP = "LCOV_EXCL_STOP"; | |
81 our $EXCL_LINE = "LCOV_EXCL_LINE"; | |
82 | |
83 our $BR_LINE = 0; | |
84 our $BR_BLOCK = 1; | |
85 our $BR_BRANCH = 2; | |
86 our $BR_TAKEN = 3; | |
87 our $BR_VEC_ENTRIES = 4; | |
88 our $BR_VEC_WIDTH = 32; | |
89 | |
90 our $UNNAMED_BLOCK = 9999; | |
91 | |
92 # Prototypes | |
93 sub print_usage(*); | |
94 sub gen_info($); | |
95 sub process_dafile($$); | |
96 sub match_filename($@); | |
97 sub solve_ambiguous_match($$$); | |
98 sub split_filename($); | |
99 sub solve_relative_path($$); | |
100 sub read_gcov_header($); | |
101 sub read_gcov_file($); | |
102 sub info(@); | |
103 sub get_gcov_version(); | |
104 sub system_no_output($@); | |
105 sub read_config($); | |
106 sub apply_config($); | |
107 sub get_exclusion_data($); | |
108 sub apply_exclusion_data($$); | |
109 sub process_graphfile($$); | |
110 sub filter_fn_name($); | |
111 sub warn_handler($); | |
112 sub die_handler($); | |
113 sub graph_error($$); | |
114 sub graph_expect($); | |
115 sub graph_read(*$;$); | |
116 sub graph_skip(*$;$); | |
117 sub sort_uniq(@); | |
118 sub sort_uniq_lex(@); | |
119 sub graph_cleanup($); | |
120 sub graph_find_base($); | |
121 sub graph_from_bb($$$); | |
122 sub graph_add_order($$$); | |
123 sub read_bb_word(*;$); | |
124 sub read_bb_value(*;$); | |
125 sub read_bb_string(*$); | |
126 sub read_bb($$); | |
127 sub read_bbg_word(*;$); | |
128 sub read_bbg_value(*;$); | |
129 sub read_bbg_string(*); | |
130 sub read_bbg_lines_record(*$$$$$$); | |
131 sub read_bbg($$); | |
132 sub read_gcno_word(*;$); | |
133 sub read_gcno_value(*$;$); | |
134 sub read_gcno_string(*$); | |
135 sub read_gcno_lines_record(*$$$$$$$); | |
136 sub read_gcno_function_record(*$$$$); | |
137 sub read_gcno($$); | |
138 sub get_gcov_capabilities(); | |
139 sub get_overall_line($$$$); | |
140 sub print_overall_rate($$$$$$$$$); | |
141 sub br_gvec_len($); | |
142 sub br_gvec_get($$); | |
143 sub debug($); | |
144 sub int_handler(); | |
145 | |
146 | |
147 # Global variables | |
148 our $gcov_version; | |
149 our $graph_file_extension; | |
150 our $data_file_extension; | |
151 our @data_directory; | |
152 our $test_name = ""; | |
153 our $quiet; | |
154 our $help; | |
155 our $output_filename; | |
156 our $base_directory; | |
157 our $version; | |
158 our $follow; | |
159 our $checksum; | |
160 our $no_checksum; | |
161 our $compat_libtool; | |
162 our $no_compat_libtool; | |
163 our $adjust_testname; | |
164 our $config; # Configuration file contents | |
165 our $compatibility; # Compatibility version flag - used to indicate | |
166 # non-standard GCOV data format versions | |
167 our @ignore_errors; # List of errors to ignore (parameter) | |
168 our @ignore; # List of errors to ignore (array) | |
169 our $initial; | |
170 our $no_recursion = 0; | |
171 our $maxdepth; | |
172 our $no_markers = 0; | |
173 our $opt_derive_func_data = 0; | |
174 our $debug = 0; | |
175 our $gcov_caps; | |
176 our @gcov_options; | |
177 | |
178 our $cwd = `pwd`; | |
179 chomp($cwd); | |
180 | |
181 | |
182 # | |
183 # Code entry point | |
184 # | |
185 | |
186 # Register handler routine to be called when interrupted | |
187 $SIG{"INT"} = \&int_handler; | |
188 $SIG{__WARN__} = \&warn_handler; | |
189 $SIG{__DIE__} = \&die_handler; | |
190 | |
191 # Prettify version string | |
192 $lcov_version =~ s/\$\s*Revision\s*:?\s*(\S+)\s*\$/$1/; | |
193 | |
194 # Set LANG so that gcov output will be in a unified format | |
195 $ENV{"LANG"} = "C"; | |
196 | |
197 # Read configuration file if available | |
198 if (defined($ENV{"HOME"}) && (-r $ENV{"HOME"}."/.lcovrc")) | |
199 { | |
200 $config = read_config($ENV{"HOME"}."/.lcovrc"); | |
201 } | |
202 elsif (-r "/etc/lcovrc") | |
203 { | |
204 $config = read_config("/etc/lcovrc"); | |
205 } | |
206 | |
207 if ($config) | |
208 { | |
209 # Copy configuration file values to variables | |
210 apply_config({ | |
211 "geninfo_gcov_tool" => \$gcov_tool, | |
212 "geninfo_adjust_testname" => \$adjust_testname, | |
213 "geninfo_checksum" => \$checksum, | |
214 "geninfo_no_checksum" => \$no_checksum, # deprecated | |
215 "geninfo_compat_libtool" => \$compat_libtool}); | |
216 | |
217 # Merge options | |
218 if (defined($no_checksum)) | |
219 { | |
220 $checksum = ($no_checksum ? 0 : 1); | |
221 $no_checksum = undef; | |
222 } | |
223 } | |
224 | |
225 # Parse command line options | |
226 if (!GetOptions("test-name|t=s" => \$test_name, | |
227 "output-filename|o=s" => \$output_filename, | |
228 "checksum" => \$checksum, | |
229 "no-checksum" => \$no_checksum, | |
230 "base-directory|b=s" => \$base_directory, | |
231 "version|v" =>\$version, | |
232 "quiet|q" => \$quiet, | |
233 "help|h|?" => \$help, | |
234 "follow|f" => \$follow, | |
235 "compat-libtool" => \$compat_libtool, | |
236 "no-compat-libtool" => \$no_compat_libtool, | |
237 "gcov-tool=s" => \$gcov_tool, | |
238 "ignore-errors=s" => \@ignore_errors, | |
239 "initial|i" => \$initial, | |
240 "no-recursion" => \$no_recursion, | |
241 "no-markers" => \$no_markers, | |
242 "derive-func-data" => \$opt_derive_func_data, | |
243 "debug" => \$debug, | |
244 )) | |
245 { | |
246 print(STDERR "Use $tool_name --help to get usage information\n"); | |
247 exit(1); | |
248 } | |
249 else | |
250 { | |
251 # Merge options | |
252 if (defined($no_checksum)) | |
253 { | |
254 $checksum = ($no_checksum ? 0 : 1); | |
255 $no_checksum = undef; | |
256 } | |
257 | |
258 if (defined($no_compat_libtool)) | |
259 { | |
260 $compat_libtool = ($no_compat_libtool ? 0 : 1); | |
261 $no_compat_libtool = undef; | |
262 } | |
263 } | |
264 | |
265 @data_directory = @ARGV; | |
266 | |
267 # Check for help option | |
268 if ($help) | |
269 { | |
270 print_usage(*STDOUT); | |
271 exit(0); | |
272 } | |
273 | |
274 # Check for version option | |
275 if ($version) | |
276 { | |
277 print("$tool_name: $lcov_version\n"); | |
278 exit(0); | |
279 } | |
280 | |
281 # Make sure test names only contain valid characters | |
282 if ($test_name =~ s/\W/_/g) | |
283 { | |
284 warn("WARNING: invalid characters removed from testname!\n"); | |
285 } | |
286 | |
287 # Adjust test name to include uname output if requested | |
288 if ($adjust_testname) | |
289 { | |
290 $test_name .= "__".`uname -a`; | |
291 $test_name =~ s/\W/_/g; | |
292 } | |
293 | |
294 # Make sure base_directory contains an absolute path specification | |
295 if ($base_directory) | |
296 { | |
297 $base_directory = solve_relative_path($cwd, $base_directory); | |
298 } | |
299 | |
300 # Check for follow option | |
301 if ($follow) | |
302 { | |
303 $follow = "-follow" | |
304 } | |
305 else | |
306 { | |
307 $follow = ""; | |
308 } | |
309 | |
310 # Determine checksum mode | |
311 if (defined($checksum)) | |
312 { | |
313 # Normalize to boolean | |
314 $checksum = ($checksum ? 1 : 0); | |
315 } | |
316 else | |
317 { | |
318 # Default is off | |
319 $checksum = 0; | |
320 } | |
321 | |
322 # Determine libtool compatibility mode | |
323 if (defined($compat_libtool)) | |
324 { | |
325 $compat_libtool = ($compat_libtool? 1 : 0); | |
326 } | |
327 else | |
328 { | |
329 # Default is on | |
330 $compat_libtool = 1; | |
331 } | |
332 | |
333 # Determine max depth for recursion | |
334 if ($no_recursion) | |
335 { | |
336 $maxdepth = "-maxdepth 1"; | |
337 } | |
338 else | |
339 { | |
340 $maxdepth = ""; | |
341 } | |
342 | |
343 # Check for directory name | |
344 if (!@data_directory) | |
345 { | |
346 die("No directory specified\n". | |
347 "Use $tool_name --help to get usage information\n"); | |
348 } | |
349 else | |
350 { | |
351 foreach (@data_directory) | |
352 { | |
353 stat($_); | |
354 if (!-r _) | |
355 { | |
356 die("ERROR: cannot read $_!\n"); | |
357 } | |
358 } | |
359 } | |
360 | |
361 if (@ignore_errors) | |
362 { | |
363 my @expanded; | |
364 my $error; | |
365 | |
366 # Expand comma-separated entries | |
367 foreach (@ignore_errors) { | |
368 if (/,/) | |
369 { | |
370 push(@expanded, split(",", $_)); | |
371 } | |
372 else | |
373 { | |
374 push(@expanded, $_); | |
375 } | |
376 } | |
377 | |
378 foreach (@expanded) | |
379 { | |
380 /^gcov$/ && do { $ignore[$ERROR_GCOV] = 1; next; } ; | |
381 /^source$/ && do { $ignore[$ERROR_SOURCE] = 1; next; }; | |
382 /^graph$/ && do { $ignore[$ERROR_GRAPH] = 1; next; }; | |
383 die("ERROR: unknown argument for --ignore-errors: $_\n"); | |
384 } | |
385 } | |
386 | |
387 if (system_no_output(3, $gcov_tool, "--help") == -1) | |
388 { | |
389 die("ERROR: need tool $gcov_tool!\n"); | |
390 } | |
391 | |
392 $gcov_version = get_gcov_version(); | |
393 | |
394 if ($gcov_version < $GCOV_VERSION_3_4_0) | |
395 { | |
396 if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER) | |
397 { | |
398 $data_file_extension = ".da"; | |
399 $graph_file_extension = ".bbg"; | |
400 } | |
401 else | |
402 { | |
403 $data_file_extension = ".da"; | |
404 $graph_file_extension = ".bb"; | |
405 } | |
406 } | |
407 else | |
408 { | |
409 $data_file_extension = ".gcda"; | |
410 $graph_file_extension = ".gcno"; | |
411 } | |
412 | |
413 # Determine gcov options | |
414 $gcov_caps = get_gcov_capabilities(); | |
415 push(@gcov_options, "-b") if ($gcov_caps->{'branch-probabilities'}); | |
416 push(@gcov_options, "-c") if ($gcov_caps->{'branch-counts'}); | |
417 push(@gcov_options, "-a") if ($gcov_caps->{'all-blocks'}); | |
418 push(@gcov_options, "-p") if ($gcov_caps->{'preserve-paths'}); | |
419 | |
420 # Check output filename | |
421 if (defined($output_filename) && ($output_filename ne "-")) | |
422 { | |
423 # Initially create output filename, data is appended | |
424 # for each data file processed | |
425 local *DUMMY_HANDLE; | |
426 open(DUMMY_HANDLE, ">$output_filename") | |
427 or die("ERROR: cannot create $output_filename!\n"); | |
428 close(DUMMY_HANDLE); | |
429 | |
430 # Make $output_filename an absolute path because we're going | |
431 # to change directories while processing files | |
432 if (!($output_filename =~ /^\/(.*)$/)) | |
433 { | |
434 $output_filename = $cwd."/".$output_filename; | |
435 } | |
436 } | |
437 | |
438 # Do something | |
439 foreach my $entry (@data_directory) { | |
440 gen_info($entry); | |
441 } | |
442 | |
443 if ($initial) { | |
444 warn("Note: --initial does not generate branch coverage ". | |
445 "data\n"); | |
446 } | |
447 info("Finished .info-file creation\n"); | |
448 | |
449 exit(0); | |
450 | |
451 | |
452 | |
453 # | |
454 # print_usage(handle) | |
455 # | |
456 # Print usage information. | |
457 # | |
458 | |
459 sub print_usage(*) | |
460 { | |
461 local *HANDLE = $_[0]; | |
462 | |
463 print(HANDLE <<END_OF_USAGE); | |
464 Usage: $tool_name [OPTIONS] DIRECTORY | |
465 | |
466 Traverse DIRECTORY and create a .info file for each data file found. Note | |
467 that you may specify more than one directory, all of which are then processed | |
468 sequentially. | |
469 | |
470 -h, --help Print this help, then exit | |
471 -v, --version Print version number, then exit | |
472 -q, --quiet Do not print progress messages | |
473 -i, --initial Capture initial zero coverage data | |
474 -t, --test-name NAME Use test case name NAME for resulting data | |
475 -o, --output-filename OUTFILE Write data only to OUTFILE | |
476 -f, --follow Follow links when searching .da/.gcda files | |
477 -b, --base-directory DIR Use DIR as base directory for relative paths | |
478 --(no-)checksum Enable (disable) line checksumming | |
479 --(no-)compat-libtool Enable (disable) libtool compatibility mode | |
480 --gcov-tool TOOL Specify gcov tool location | |
481 --ignore-errors ERROR Continue after ERROR (gcov, source, graph) | |
482 --no-recursion Exclude subdirectories from processing | |
483 --function-coverage Capture function call counts | |
484 --no-markers Ignore exclusion markers in source code | |
485 --derive-func-data Generate function data from line data | |
486 | |
487 For more information see: $lcov_url | |
488 END_OF_USAGE | |
489 ; | |
490 } | |
491 | |
492 # | |
493 # get_common_prefix(min_dir, filenames) | |
494 # | |
495 # Return the longest path prefix shared by all filenames. MIN_DIR specifies | |
496 # the minimum number of directories that a filename may have after removing | |
497 # the prefix. | |
498 # | |
499 | |
500 sub get_common_prefix($@) | |
501 { | |
502 my ($min_dir, @files) = @_; | |
503 my $file; | |
504 my @prefix; | |
505 my $i; | |
506 | |
507 foreach $file (@files) { | |
508 my ($v, $d, $f) = splitpath($file); | |
509 my @comp = splitdir($d); | |
510 | |
511 if (!@prefix) { | |
512 @prefix = @comp; | |
513 next; | |
514 } | |
515 for ($i = 0; $i < scalar(@comp) && $i < scalar(@prefix); $i++) { | |
516 if ($comp[$i] ne $prefix[$i] || | |
517 ((scalar(@comp) - ($i + 1)) <= $min_dir)) { | |
518 delete(@prefix[$i..scalar(@prefix)]); | |
519 last; | |
520 } | |
521 } | |
522 } | |
523 | |
524 return catdir(@prefix); | |
525 } | |
526 | |
527 # | |
528 # gen_info(directory) | |
529 # | |
530 # Traverse DIRECTORY and create a .info file for each data file found. | |
531 # The .info file contains TEST_NAME in the following format: | |
532 # | |
533 # TN:<test name> | |
534 # | |
535 # For each source file name referenced in the data file, there is a section | |
536 # containing source code and coverage data: | |
537 # | |
538 # SF:<absolute path to the source file> | |
539 # FN:<line number of function start>,<function name> for each function | |
540 # DA:<line number>,<execution count> for each instrumented line | |
541 # LH:<number of lines with an execution count> greater than 0 | |
542 # LF:<number of instrumented lines> | |
543 # | |
544 # Sections are separated by: | |
545 # | |
546 # end_of_record | |
547 # | |
548 # In addition to the main source code file there are sections for each | |
549 # #included file containing executable code. Note that the absolute path | |
550 # of a source file is generated by interpreting the contents of the respective | |
551 # graph file. Relative filenames are prefixed with the directory in which the | |
552 # graph file is found. Note also that symbolic links to the graph file will be | |
553 # resolved so that the actual file path is used instead of the path to a link. | |
554 # This approach is necessary for the mechanism to work with the /proc/gcov | |
555 # files. | |
556 # | |
557 # Die on error. | |
558 # | |
559 | |
560 sub gen_info($) | |
561 { | |
562 my $directory = $_[0]; | |
563 my @file_list; | |
564 my $file; | |
565 my $prefix; | |
566 my $type; | |
567 my $ext; | |
568 | |
569 if ($initial) { | |
570 $type = "graph"; | |
571 $ext = $graph_file_extension; | |
572 } else { | |
573 $type = "data"; | |
574 $ext = $data_file_extension; | |
575 } | |
576 | |
577 if (-d $directory) | |
578 { | |
579 info("Scanning $directory for $ext files ...\n"); | |
580 | |
581 @file_list = `find "$directory" $maxdepth $follow -name \\*$ext
-type f 2>/dev/null`; | |
582 chomp(@file_list); | |
583 @file_list or | |
584 die("ERROR: no $ext files found in $directory!\n"); | |
585 $prefix = get_common_prefix(1, @file_list); | |
586 info("Found %d %s files in %s\n", $#file_list+1, $type, | |
587 $directory); | |
588 } | |
589 else | |
590 { | |
591 @file_list = ($directory); | |
592 $prefix = ""; | |
593 } | |
594 | |
595 # Process all files in list | |
596 foreach $file (@file_list) { | |
597 # Process file | |
598 if ($initial) { | |
599 process_graphfile($file, $prefix); | |
600 } else { | |
601 process_dafile($file, $prefix); | |
602 } | |
603 } | |
604 } | |
605 | |
606 | |
607 sub derive_data($$$) | |
608 { | |
609 my ($contentdata, $funcdata, $bbdata) = @_; | |
610 my @gcov_content = @{$contentdata}; | |
611 my @gcov_functions = @{$funcdata}; | |
612 my %fn_count; | |
613 my %ln_fn; | |
614 my $line; | |
615 my $maxline; | |
616 my %fn_name; | |
617 my $fn; | |
618 my $count; | |
619 | |
620 if (!defined($bbdata)) { | |
621 return @gcov_functions; | |
622 } | |
623 | |
624 # First add existing function data | |
625 while (@gcov_functions) { | |
626 $count = shift(@gcov_functions); | |
627 $fn = shift(@gcov_functions); | |
628 | |
629 $fn_count{$fn} = $count; | |
630 } | |
631 | |
632 # Convert line coverage data to function data | |
633 foreach $fn (keys(%{$bbdata})) { | |
634 my $line_data = $bbdata->{$fn}; | |
635 my $line; | |
636 | |
637 if ($fn eq "") { | |
638 next; | |
639 } | |
640 # Find the lowest line count for this function | |
641 $count = 0; | |
642 foreach $line (@$line_data) { | |
643 my $lcount = $gcov_content[ ( $line - 1 ) * 3 + 1 ]; | |
644 | |
645 if (($lcount > 0) && | |
646 (($count == 0) || ($lcount < $count))) { | |
647 $count = $lcount; | |
648 } | |
649 } | |
650 $fn_count{$fn} = $count; | |
651 } | |
652 | |
653 | |
654 # Check if we got data for all functions | |
655 foreach $fn (keys(%fn_name)) { | |
656 if ($fn eq "") { | |
657 next; | |
658 } | |
659 if (defined($fn_count{$fn})) { | |
660 next; | |
661 } | |
662 warn("WARNING: no derived data found for function $fn\n"); | |
663 } | |
664 | |
665 # Convert hash to list in @gcov_functions format | |
666 foreach $fn (sort(keys(%fn_count))) { | |
667 push(@gcov_functions, $fn_count{$fn}, $fn); | |
668 } | |
669 | |
670 return @gcov_functions; | |
671 } | |
672 | |
673 # | |
674 # get_filenames(directory, pattern) | |
675 # | |
676 # Return a list of filenames found in directory which match the specified | |
677 # pattern. | |
678 # | |
679 # Die on error. | |
680 # | |
681 | |
682 sub get_filenames($$) | |
683 { | |
684 my ($dirname, $pattern) = @_; | |
685 my @result; | |
686 my $directory; | |
687 local *DIR; | |
688 | |
689 opendir(DIR, $dirname) or | |
690 die("ERROR: cannot read directory $dirname\n"); | |
691 while ($directory = readdir(DIR)) { | |
692 push(@result, $directory) if ($directory =~ /$pattern/); | |
693 } | |
694 closedir(DIR); | |
695 | |
696 return @result; | |
697 } | |
698 | |
699 # | |
700 # process_dafile(da_filename, dir) | |
701 # | |
702 # Create a .info file for a single data file. | |
703 # | |
704 # Die on error. | |
705 # | |
706 | |
707 sub process_dafile($$) | |
708 { | |
709 my ($file, $dir) = @_; | |
710 my $da_filename; # Name of data file to process | |
711 my $da_dir; # Directory of data file | |
712 my $source_dir; # Directory of source file | |
713 my $da_basename; # data filename without ".da/.gcda" extension | |
714 my $bb_filename; # Name of respective graph file | |
715 my $bb_basename; # Basename of the original graph file | |
716 my $graph; # Contents of graph file | |
717 my $instr; # Contents of graph file part 2 | |
718 my $gcov_error; # Error code of gcov tool | |
719 my $object_dir; # Directory containing all object files | |
720 my $source_filename; # Name of a source code file | |
721 my $gcov_file; # Name of a .gcov file | |
722 my @gcov_content; # Content of a .gcov file | |
723 my $gcov_branches; # Branch content of a .gcov file | |
724 my @gcov_functions; # Function calls of a .gcov file | |
725 my @gcov_list; # List of generated .gcov files | |
726 my $line_number; # Line number count | |
727 my $lines_hit; # Number of instrumented lines hit | |
728 my $lines_found; # Number of instrumented lines found | |
729 my $funcs_hit; # Number of instrumented functions hit | |
730 my $funcs_found; # Number of instrumented functions found | |
731 my $br_hit; | |
732 my $br_found; | |
733 my $source; # gcov source header information | |
734 my $object; # gcov object header information | |
735 my @matches; # List of absolute paths matching filename | |
736 my @unprocessed; # List of unprocessed source code files | |
737 my $base_dir; # Base directory for current file | |
738 my @tmp_links; # Temporary links to be cleaned up | |
739 my @result; | |
740 my $index; | |
741 my $da_renamed; # If data file is to be renamed | |
742 local *INFO_HANDLE; | |
743 | |
744 info("Processing %s\n", abs2rel($file, $dir)); | |
745 # Get path to data file in absolute and normalized form (begins with /, | |
746 # contains no more ../ or ./) | |
747 $da_filename = solve_relative_path($cwd, $file); | |
748 | |
749 # Get directory and basename of data file | |
750 ($da_dir, $da_basename) = split_filename($da_filename); | |
751 | |
752 # avoid files from .libs dirs | |
753 if ($compat_libtool && $da_dir =~ m/(.*)\/\.libs$/) { | |
754 $source_dir = $1; | |
755 } else { | |
756 $source_dir = $da_dir; | |
757 } | |
758 | |
759 if (-z $da_filename) | |
760 { | |
761 $da_renamed = 1; | |
762 } | |
763 else | |
764 { | |
765 $da_renamed = 0; | |
766 } | |
767 | |
768 # Construct base_dir for current file | |
769 if ($base_directory) | |
770 { | |
771 $base_dir = $base_directory; | |
772 } | |
773 else | |
774 { | |
775 $base_dir = $source_dir; | |
776 } | |
777 | |
778 # Check for writable $base_dir (gcov will try to write files there) | |
779 stat($base_dir); | |
780 if (!-w _) | |
781 { | |
782 die("ERROR: cannot write to directory $base_dir!\n"); | |
783 } | |
784 | |
785 # Construct name of graph file | |
786 $bb_basename = $da_basename.$graph_file_extension; | |
787 $bb_filename = "$da_dir/$bb_basename"; | |
788 | |
789 # Find out the real location of graph file in case we're just looking at | |
790 # a link | |
791 while (readlink($bb_filename)) | |
792 { | |
793 my $last_dir = dirname($bb_filename); | |
794 | |
795 $bb_filename = readlink($bb_filename); | |
796 $bb_filename = solve_relative_path($last_dir, $bb_filename); | |
797 } | |
798 | |
799 # Ignore empty graph file (e.g. source file with no statement) | |
800 if (-z $bb_filename) | |
801 { | |
802 warn("WARNING: empty $bb_filename (skipped)\n"); | |
803 return; | |
804 } | |
805 | |
806 # Read contents of graph file into hash. We need it later to find out | |
807 # the absolute path to each .gcov file created as well as for | |
808 # information about functions and their source code positions. | |
809 if ($gcov_version < $GCOV_VERSION_3_4_0) | |
810 { | |
811 if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER) | |
812 { | |
813 ($instr, $graph) = read_bbg($bb_filename, $base_dir); | |
814 } | |
815 else | |
816 { | |
817 ($instr, $graph) = read_bb($bb_filename, $base_dir); | |
818 } | |
819 } | |
820 else | |
821 { | |
822 ($instr, $graph) = read_gcno($bb_filename, $base_dir); | |
823 } | |
824 | |
825 # Set $object_dir to real location of object files. This may differ | |
826 # from $da_dir if the graph file is just a link to the "real" object | |
827 # file location. | |
828 $object_dir = dirname($bb_filename); | |
829 | |
830 # Is the data file in a different directory? (this happens e.g. with | |
831 # the gcov-kernel patch) | |
832 if ($object_dir ne $da_dir) | |
833 { | |
834 # Need to create link to data file in $object_dir | |
835 system("ln", "-s", $da_filename, | |
836 "$object_dir/$da_basename$data_file_extension") | |
837 and die ("ERROR: cannot create link $object_dir/". | |
838 "$da_basename$data_file_extension!\n"); | |
839 push(@tmp_links, | |
840 "$object_dir/$da_basename$data_file_extension"); | |
841 # Need to create link to graph file if basename of link | |
842 # and file are different (CONFIG_MODVERSION compat) | |
843 if ((basename($bb_filename) ne $bb_basename) && | |
844 (! -e "$object_dir/$bb_basename")) { | |
845 symlink($bb_filename, "$object_dir/$bb_basename") or | |
846 warn("WARNING: cannot create link ". | |
847 "$object_dir/$bb_basename\n"); | |
848 push(@tmp_links, "$object_dir/$bb_basename"); | |
849 } | |
850 } | |
851 | |
852 # Change to directory containing data files and apply GCOV | |
853 chdir($base_dir); | |
854 | |
855 if ($da_renamed) | |
856 { | |
857 # Need to rename empty data file to workaround | |
858 # gcov <= 3.2.x bug (Abort) | |
859 system_no_output(3, "mv", "$da_filename", "$da_filename.ori") | |
860 and die ("ERROR: cannot rename $da_filename\n"); | |
861 } | |
862 | |
863 # Execute gcov command and suppress standard output | |
864 $gcov_error = system_no_output(1, $gcov_tool, $da_filename, | |
865 "-o", $object_dir, @gcov_options); | |
866 | |
867 if ($da_renamed) | |
868 { | |
869 system_no_output(3, "mv", "$da_filename.ori", "$da_filename") | |
870 and die ("ERROR: cannot rename $da_filename.ori"); | |
871 } | |
872 | |
873 # Clean up temporary links | |
874 foreach (@tmp_links) { | |
875 unlink($_); | |
876 } | |
877 | |
878 if ($gcov_error) | |
879 { | |
880 if ($ignore[$ERROR_GCOV]) | |
881 { | |
882 warn("WARNING: GCOV failed for $da_filename!\n"); | |
883 return; | |
884 } | |
885 die("ERROR: GCOV failed for $da_filename!\n"); | |
886 } | |
887 | |
888 # Collect data from resulting .gcov files and create .info file | |
889 @gcov_list = get_filenames('.', '\.gcov$'); | |
890 | |
891 # Check for files | |
892 if (!@gcov_list) | |
893 { | |
894 warn("WARNING: gcov did not create any files for ". | |
895 "$da_filename!\n"); | |
896 } | |
897 | |
898 # Check whether we're writing to a single file | |
899 if ($output_filename) | |
900 { | |
901 if ($output_filename eq "-") | |
902 { | |
903 *INFO_HANDLE = *STDOUT; | |
904 } | |
905 else | |
906 { | |
907 # Append to output file | |
908 open(INFO_HANDLE, ">>$output_filename") | |
909 or die("ERROR: cannot write to ". | |
910 "$output_filename!\n"); | |
911 } | |
912 } | |
913 else | |
914 { | |
915 # Open .info file for output | |
916 open(INFO_HANDLE, ">$da_filename.info") | |
917 or die("ERROR: cannot create $da_filename.info!\n"); | |
918 } | |
919 | |
920 # Write test name | |
921 printf(INFO_HANDLE "TN:%s\n", $test_name); | |
922 | |
923 # Traverse the list of generated .gcov files and combine them into a | |
924 # single .info file | |
925 @unprocessed = keys(%{$instr}); | |
926 foreach $gcov_file (sort(@gcov_list)) | |
927 { | |
928 my $i; | |
929 my $num; | |
930 | |
931 ($source, $object) = read_gcov_header($gcov_file); | |
932 | |
933 if (defined($source)) | |
934 { | |
935 $source = solve_relative_path($base_dir, $source); | |
936 } | |
937 | |
938 # gcov will happily create output even if there's no source code | |
939 # available - this interferes with checksum creation so we need | |
940 # to pull the emergency brake here. | |
941 if (defined($source) && ! -r $source && $checksum) | |
942 { | |
943 if ($ignore[$ERROR_SOURCE]) | |
944 { | |
945 warn("WARNING: could not read source file ". | |
946 "$source\n"); | |
947 next; | |
948 } | |
949 die("ERROR: could not read source file $source\n"); | |
950 } | |
951 | |
952 @matches = match_filename(defined($source) ? $source : | |
953 $gcov_file, keys(%{$instr})); | |
954 | |
955 # Skip files that are not mentioned in the graph file | |
956 if (!@matches) | |
957 { | |
958 warn("WARNING: cannot find an entry for ".$gcov_file. | |
959 " in $graph_file_extension file, skipping ". | |
960 "file!\n"); | |
961 unlink($gcov_file); | |
962 next; | |
963 } | |
964 | |
965 # Read in contents of gcov file | |
966 @result = read_gcov_file($gcov_file); | |
967 if (!defined($result[0])) { | |
968 warn("WARNING: skipping unreadable file ". | |
969 $gcov_file."\n"); | |
970 unlink($gcov_file); | |
971 next; | |
972 } | |
973 @gcov_content = @{$result[0]}; | |
974 $gcov_branches = $result[1]; | |
975 @gcov_functions = @{$result[2]}; | |
976 | |
977 # Skip empty files | |
978 if (!@gcov_content) | |
979 { | |
980 warn("WARNING: skipping empty file ".$gcov_file."\n"); | |
981 unlink($gcov_file); | |
982 next; | |
983 } | |
984 | |
985 if (scalar(@matches) == 1) | |
986 { | |
987 # Just one match | |
988 $source_filename = $matches[0]; | |
989 } | |
990 else | |
991 { | |
992 # Try to solve the ambiguity | |
993 $source_filename = solve_ambiguous_match($gcov_file, | |
994 \@matches, \@gcov_content); | |
995 } | |
996 | |
997 # Remove processed file from list | |
998 for ($index = scalar(@unprocessed) - 1; $index >= 0; $index--) | |
999 { | |
1000 if ($unprocessed[$index] eq $source_filename) | |
1001 { | |
1002 splice(@unprocessed, $index, 1); | |
1003 last; | |
1004 } | |
1005 } | |
1006 | |
1007 # Write absolute path of source file | |
1008 printf(INFO_HANDLE "SF:%s\n", $source_filename); | |
1009 | |
1010 # If requested, derive function coverage data from | |
1011 # line coverage data of the first line of a function | |
1012 if ($opt_derive_func_data) { | |
1013 @gcov_functions = | |
1014 derive_data(\@gcov_content, \@gcov_functions, | |
1015 $graph->{$source_filename}); | |
1016 } | |
1017 | |
1018 # Write function-related information | |
1019 if (defined($graph->{$source_filename})) | |
1020 { | |
1021 my $fn_data = $graph->{$source_filename}; | |
1022 my $fn; | |
1023 | |
1024 foreach $fn (sort | |
1025 {$fn_data->{$a}->[0] <=> $fn_data->{$b}->[0]} | |
1026 keys(%{$fn_data})) { | |
1027 my $ln_data = $fn_data->{$fn}; | |
1028 my $line = $ln_data->[0]; | |
1029 | |
1030 # Skip empty function | |
1031 if ($fn eq "") { | |
1032 next; | |
1033 } | |
1034 # Remove excluded functions | |
1035 if (!$no_markers) { | |
1036 my $gfn; | |
1037 my $found = 0; | |
1038 | |
1039 foreach $gfn (@gcov_functions) { | |
1040 if ($gfn eq $fn) { | |
1041 $found = 1; | |
1042 last; | |
1043 } | |
1044 } | |
1045 if (!$found) { | |
1046 next; | |
1047 } | |
1048 } | |
1049 | |
1050 # Normalize function name | |
1051 $fn = filter_fn_name($fn); | |
1052 | |
1053 print(INFO_HANDLE "FN:$line,$fn\n"); | |
1054 } | |
1055 } | |
1056 | |
1057 #-- | |
1058 #-- FNDA: <call-count>, <function-name> | |
1059 #-- FNF: overall count of functions | |
1060 #-- FNH: overall count of functions with non-zero call count | |
1061 #-- | |
1062 $funcs_found = 0; | |
1063 $funcs_hit = 0; | |
1064 while (@gcov_functions) | |
1065 { | |
1066 my $count = shift(@gcov_functions); | |
1067 my $fn = shift(@gcov_functions); | |
1068 | |
1069 $fn = filter_fn_name($fn); | |
1070 printf(INFO_HANDLE "FNDA:$count,$fn\n"); | |
1071 $funcs_found++; | |
1072 $funcs_hit++ if ($count > 0); | |
1073 } | |
1074 if ($funcs_found > 0) { | |
1075 printf(INFO_HANDLE "FNF:%s\n", $funcs_found); | |
1076 printf(INFO_HANDLE "FNH:%s\n", $funcs_hit); | |
1077 } | |
1078 | |
1079 # Write coverage information for each instrumented branch: | |
1080 # | |
1081 # BRDA:<line number>,<block number>,<branch number>,<taken> | |
1082 # | |
1083 # where 'taken' is the number of times the branch was taken | |
1084 # or '-' if the block to which the branch belongs was never | |
1085 # executed | |
1086 $br_found = 0; | |
1087 $br_hit = 0; | |
1088 $num = br_gvec_len($gcov_branches); | |
1089 for ($i = 0; $i < $num; $i++) { | |
1090 my ($line, $block, $branch, $taken) = | |
1091 br_gvec_get($gcov_branches, $i); | |
1092 | |
1093 print(INFO_HANDLE "BRDA:$line,$block,$branch,$taken\n"); | |
1094 $br_found++; | |
1095 $br_hit++ if ($taken ne '-' && $taken > 0); | |
1096 } | |
1097 if ($br_found > 0) { | |
1098 printf(INFO_HANDLE "BRF:%s\n", $br_found); | |
1099 printf(INFO_HANDLE "BRH:%s\n", $br_hit); | |
1100 } | |
1101 | |
1102 # Reset line counters | |
1103 $line_number = 0; | |
1104 $lines_found = 0; | |
1105 $lines_hit = 0; | |
1106 | |
1107 # Write coverage information for each instrumented line | |
1108 # Note: @gcov_content contains a list of (flag, count, source) | |
1109 # tuple for each source code line | |
1110 while (@gcov_content) | |
1111 { | |
1112 $line_number++; | |
1113 | |
1114 # Check for instrumented line | |
1115 if ($gcov_content[0]) | |
1116 { | |
1117 $lines_found++; | |
1118 printf(INFO_HANDLE "DA:".$line_number.",". | |
1119 $gcov_content[1].($checksum ? | |
1120 ",". md5_base64($gcov_content[2]) : ""). | |
1121 "\n"); | |
1122 | |
1123 # Increase $lines_hit in case of an execution | |
1124 # count>0 | |
1125 if ($gcov_content[1] > 0) { $lines_hit++; } | |
1126 } | |
1127 | |
1128 # Remove already processed data from array | |
1129 splice(@gcov_content,0,3); | |
1130 } | |
1131 | |
1132 # Write line statistics and section separator | |
1133 printf(INFO_HANDLE "LF:%s\n", $lines_found); | |
1134 printf(INFO_HANDLE "LH:%s\n", $lines_hit); | |
1135 print(INFO_HANDLE "end_of_record\n"); | |
1136 | |
1137 # Remove .gcov file after processing | |
1138 unlink($gcov_file); | |
1139 } | |
1140 | |
1141 # Check for files which show up in the graph file but were never | |
1142 # processed | |
1143 if (@unprocessed && @gcov_list) | |
1144 { | |
1145 foreach (@unprocessed) | |
1146 { | |
1147 warn("WARNING: no data found for $_\n"); | |
1148 } | |
1149 } | |
1150 | |
1151 if (!($output_filename && ($output_filename eq "-"))) | |
1152 { | |
1153 close(INFO_HANDLE); | |
1154 } | |
1155 | |
1156 # Change back to initial directory | |
1157 chdir($cwd); | |
1158 } | |
1159 | |
1160 | |
1161 # | |
1162 # solve_relative_path(path, dir) | |
1163 # | |
1164 # Solve relative path components of DIR which, if not absolute, resides in PATH. | |
1165 # | |
1166 | |
1167 sub solve_relative_path($$) | |
1168 { | |
1169 my $path = $_[0]; | |
1170 my $dir = $_[1]; | |
1171 my $result; | |
1172 | |
1173 $result = $dir; | |
1174 # Prepend path if not absolute | |
1175 if ($dir =~ /^[^\/]/) | |
1176 { | |
1177 $result = "$path/$result"; | |
1178 } | |
1179 | |
1180 # Remove // | |
1181 $result =~ s/\/\//\//g; | |
1182 | |
1183 # Remove . | |
1184 $result =~ s/\/\.\//\//g; | |
1185 | |
1186 # Solve .. | |
1187 while ($result =~ s/\/[^\/]+\/\.\.\//\//) | |
1188 { | |
1189 } | |
1190 | |
1191 # Remove preceding .. | |
1192 $result =~ s/^\/\.\.\//\//g; | |
1193 | |
1194 return $result; | |
1195 } | |
1196 | |
1197 | |
1198 # | |
1199 # match_filename(gcov_filename, list) | |
1200 # | |
1201 # Return a list of those entries of LIST which match the relative filename | |
1202 # GCOV_FILENAME. | |
1203 # | |
1204 | |
1205 sub match_filename($@) | |
1206 { | |
1207 my ($filename, @list) = @_; | |
1208 my ($vol, $dir, $file) = splitpath($filename); | |
1209 my @comp = splitdir($dir); | |
1210 my $comps = scalar(@comp); | |
1211 my $entry; | |
1212 my @result; | |
1213 | |
1214 entry: | |
1215 foreach $entry (@list) { | |
1216 my ($evol, $edir, $efile) = splitpath($entry); | |
1217 my @ecomp; | |
1218 my $ecomps; | |
1219 my $i; | |
1220 | |
1221 # Filename component must match | |
1222 if ($efile ne $file) { | |
1223 next; | |
1224 } | |
1225 # Check directory components last to first for match | |
1226 @ecomp = splitdir($edir); | |
1227 $ecomps = scalar(@ecomp); | |
1228 if ($ecomps < $comps) { | |
1229 next; | |
1230 } | |
1231 for ($i = 0; $i < $comps; $i++) { | |
1232 if ($comp[$comps - $i - 1] ne | |
1233 $ecomp[$ecomps - $i - 1]) { | |
1234 next entry; | |
1235 } | |
1236 } | |
1237 push(@result, $entry), | |
1238 } | |
1239 | |
1240 return @result; | |
1241 } | |
1242 | |
1243 # | |
1244 # solve_ambiguous_match(rel_filename, matches_ref, gcov_content_ref) | |
1245 # | |
1246 # Try to solve ambiguous matches of mapping (gcov file) -> (source code) file | |
1247 # by comparing source code provided in the GCOV file with that of the files | |
1248 # in MATCHES. REL_FILENAME identifies the relative filename of the gcov | |
1249 # file. | |
1250 # | |
1251 # Return the one real match or die if there is none. | |
1252 # | |
1253 | |
1254 sub solve_ambiguous_match($$$) | |
1255 { | |
1256 my $rel_name = $_[0]; | |
1257 my $matches = $_[1]; | |
1258 my $content = $_[2]; | |
1259 my $filename; | |
1260 my $index; | |
1261 my $no_match; | |
1262 local *SOURCE; | |
1263 | |
1264 # Check the list of matches | |
1265 foreach $filename (@$matches) | |
1266 { | |
1267 | |
1268 # Compare file contents | |
1269 open(SOURCE, $filename) | |
1270 or die("ERROR: cannot read $filename!\n"); | |
1271 | |
1272 $no_match = 0; | |
1273 for ($index = 2; <SOURCE>; $index += 3) | |
1274 { | |
1275 chomp; | |
1276 | |
1277 # Also remove CR from line-end | |
1278 s/\015$//; | |
1279 | |
1280 if ($_ ne @$content[$index]) | |
1281 { | |
1282 $no_match = 1; | |
1283 last; | |
1284 } | |
1285 } | |
1286 | |
1287 close(SOURCE); | |
1288 | |
1289 if (!$no_match) | |
1290 { | |
1291 info("Solved source file ambiguity for $rel_name\n"); | |
1292 return $filename; | |
1293 } | |
1294 } | |
1295 | |
1296 die("ERROR: could not match gcov data for $rel_name!\n"); | |
1297 } | |
1298 | |
1299 | |
1300 # | |
1301 # split_filename(filename) | |
1302 # | |
1303 # Return (path, filename, extension) for a given FILENAME. | |
1304 # | |
1305 | |
1306 sub split_filename($) | |
1307 { | |
1308 my @path_components = split('/', $_[0]); | |
1309 my @file_components = split('\.', pop(@path_components)); | |
1310 my $extension = pop(@file_components); | |
1311 | |
1312 return (join("/",@path_components), join(".",@file_components), | |
1313 $extension); | |
1314 } | |
1315 | |
1316 | |
1317 # | |
1318 # read_gcov_header(gcov_filename) | |
1319 # | |
1320 # Parse file GCOV_FILENAME and return a list containing the following | |
1321 # information: | |
1322 # | |
1323 # (source, object) | |
1324 # | |
1325 # where: | |
1326 # | |
1327 # source: complete relative path of the source code file (gcc >= 3.3 only) | |
1328 # object: name of associated graph file | |
1329 # | |
1330 # Die on error. | |
1331 # | |
1332 | |
1333 sub read_gcov_header($) | |
1334 { | |
1335 my $source; | |
1336 my $object; | |
1337 local *INPUT; | |
1338 | |
1339 if (!open(INPUT, $_[0])) | |
1340 { | |
1341 if ($ignore_errors[$ERROR_GCOV]) | |
1342 { | |
1343 warn("WARNING: cannot read $_[0]!\n"); | |
1344 return (undef,undef); | |
1345 } | |
1346 die("ERROR: cannot read $_[0]!\n"); | |
1347 } | |
1348 | |
1349 while (<INPUT>) | |
1350 { | |
1351 chomp($_); | |
1352 | |
1353 # Also remove CR from line-end | |
1354 s/\015$//; | |
1355 | |
1356 if (/^\s+-:\s+0:Source:(.*)$/) | |
1357 { | |
1358 # Source: header entry | |
1359 $source = $1; | |
1360 } | |
1361 elsif (/^\s+-:\s+0:Object:(.*)$/) | |
1362 { | |
1363 # Object: header entry | |
1364 $object = $1; | |
1365 } | |
1366 else | |
1367 { | |
1368 last; | |
1369 } | |
1370 } | |
1371 | |
1372 close(INPUT); | |
1373 | |
1374 return ($source, $object); | |
1375 } | |
1376 | |
1377 | |
1378 # | |
1379 # br_gvec_len(vector) | |
1380 # | |
1381 # Return the number of entries in the branch coverage vector. | |
1382 # | |
1383 | |
1384 sub br_gvec_len($) | |
1385 { | |
1386 my ($vec) = @_; | |
1387 | |
1388 return 0 if (!defined($vec)); | |
1389 return (length($vec) * 8 / $BR_VEC_WIDTH) / $BR_VEC_ENTRIES; | |
1390 } | |
1391 | |
1392 | |
1393 # | |
1394 # br_gvec_get(vector, number) | |
1395 # | |
1396 # Return an entry from the branch coverage vector. | |
1397 # | |
1398 | |
1399 sub br_gvec_get($$) | |
1400 { | |
1401 my ($vec, $num) = @_; | |
1402 my $line; | |
1403 my $block; | |
1404 my $branch; | |
1405 my $taken; | |
1406 my $offset = $num * $BR_VEC_ENTRIES; | |
1407 | |
1408 # Retrieve data from vector | |
1409 $line = vec($vec, $offset + $BR_LINE, $BR_VEC_WIDTH); | |
1410 $block = vec($vec, $offset + $BR_BLOCK, $BR_VEC_WIDTH); | |
1411 $branch = vec($vec, $offset + $BR_BRANCH, $BR_VEC_WIDTH); | |
1412 $taken = vec($vec, $offset + $BR_TAKEN, $BR_VEC_WIDTH); | |
1413 | |
1414 # Decode taken value from an integer | |
1415 if ($taken == 0) { | |
1416 $taken = "-"; | |
1417 } else { | |
1418 $taken--; | |
1419 } | |
1420 | |
1421 return ($line, $block, $branch, $taken); | |
1422 } | |
1423 | |
1424 | |
1425 # | |
1426 # br_gvec_push(vector, line, block, branch, taken) | |
1427 # | |
1428 # Add an entry to the branch coverage vector. | |
1429 # | |
1430 | |
1431 sub br_gvec_push($$$$$) | |
1432 { | |
1433 my ($vec, $line, $block, $branch, $taken) = @_; | |
1434 my $offset; | |
1435 | |
1436 $vec = "" if (!defined($vec)); | |
1437 $offset = br_gvec_len($vec) * $BR_VEC_ENTRIES; | |
1438 | |
1439 # Encode taken value into an integer | |
1440 if ($taken eq "-") { | |
1441 $taken = 0; | |
1442 } else { | |
1443 $taken++; | |
1444 } | |
1445 | |
1446 # Add to vector | |
1447 vec($vec, $offset + $BR_LINE, $BR_VEC_WIDTH) = $line; | |
1448 vec($vec, $offset + $BR_BLOCK, $BR_VEC_WIDTH) = $block; | |
1449 vec($vec, $offset + $BR_BRANCH, $BR_VEC_WIDTH) = $branch; | |
1450 vec($vec, $offset + $BR_TAKEN, $BR_VEC_WIDTH) = $taken; | |
1451 | |
1452 return $vec; | |
1453 } | |
1454 | |
1455 | |
1456 # | |
1457 # read_gcov_file(gcov_filename) | |
1458 # | |
1459 # Parse file GCOV_FILENAME (.gcov file format) and return the list: | |
1460 # (reference to gcov_content, reference to gcov_branch, reference to gcov_func) | |
1461 # | |
1462 # gcov_content is a list of 3 elements | |
1463 # (flag, count, source) for each source code line: | |
1464 # | |
1465 # $result[($line_number-1)*3+0] = instrumentation flag for line $line_number | |
1466 # $result[($line_number-1)*3+1] = execution count for line $line_number | |
1467 # $result[($line_number-1)*3+2] = source code text for line $line_number | |
1468 # | |
1469 # gcov_branch is a vector of 4 4-byte long elements for each branch: | |
1470 # line number, block number, branch number, count + 1 or 0 | |
1471 # | |
1472 # gcov_func is a list of 2 elements | |
1473 # (number of calls, function name) for each function | |
1474 # | |
1475 # Die on error. | |
1476 # | |
1477 | |
1478 sub read_gcov_file($) | |
1479 { | |
1480 my $filename = $_[0]; | |
1481 my @result = (); | |
1482 my $branches = ""; | |
1483 my @functions = (); | |
1484 my $number; | |
1485 my $exclude_flag = 0; | |
1486 my $exclude_line = 0; | |
1487 my $last_block = $UNNAMED_BLOCK; | |
1488 my $last_line = 0; | |
1489 local *INPUT; | |
1490 | |
1491 if (!open(INPUT, $filename)) { | |
1492 if ($ignore_errors[$ERROR_GCOV]) | |
1493 { | |
1494 warn("WARNING: cannot read $filename!\n"); | |
1495 return (undef, undef, undef); | |
1496 } | |
1497 die("ERROR: cannot read $filename!\n"); | |
1498 } | |
1499 | |
1500 if ($gcov_version < $GCOV_VERSION_3_3_0) | |
1501 { | |
1502 # Expect gcov format as used in gcc < 3.3 | |
1503 while (<INPUT>) | |
1504 { | |
1505 chomp($_); | |
1506 | |
1507 # Also remove CR from line-end | |
1508 s/\015$//; | |
1509 | |
1510 if (/^branch\s+(\d+)\s+taken\s+=\s+(\d+)/) { | |
1511 next if ($exclude_line); | |
1512 $branches = br_gvec_push($branches, $last_line, | |
1513 $last_block, $1, $2); | |
1514 } elsif (/^branch\s+(\d+)\s+never\s+executed/) { | |
1515 next if ($exclude_line); | |
1516 $branches = br_gvec_push($branches, $last_line, | |
1517 $last_block, $1, '-'); | |
1518 } | |
1519 elsif (/^call/ || /^function/) | |
1520 { | |
1521 # Function call return data | |
1522 } | |
1523 else | |
1524 { | |
1525 $last_line++; | |
1526 # Check for exclusion markers | |
1527 if (!$no_markers) { | |
1528 if (/$EXCL_STOP/) { | |
1529 $exclude_flag = 0; | |
1530 } elsif (/$EXCL_START/) { | |
1531 $exclude_flag = 1; | |
1532 } | |
1533 if (/$EXCL_LINE/ || $exclude_flag) { | |
1534 $exclude_line = 1; | |
1535 } else { | |
1536 $exclude_line = 0; | |
1537 } | |
1538 } | |
1539 # Source code execution data | |
1540 if (/^\t\t(.*)$/) | |
1541 { | |
1542 # Uninstrumented line | |
1543 push(@result, 0); | |
1544 push(@result, 0); | |
1545 push(@result, $1); | |
1546 next; | |
1547 } | |
1548 $number = (split(" ",substr($_, 0, 16)))[0]; | |
1549 | |
1550 # Check for zero count which is indicated | |
1551 # by ###### | |
1552 if ($number eq "######") { $number = 0; } | |
1553 | |
1554 if ($exclude_line) { | |
1555 # Register uninstrumented line instead | |
1556 push(@result, 0); | |
1557 push(@result, 0); | |
1558 } else { | |
1559 push(@result, 1); | |
1560 push(@result, $number); | |
1561 } | |
1562 push(@result, substr($_, 16)); | |
1563 } | |
1564 } | |
1565 } | |
1566 else | |
1567 { | |
1568 # Expect gcov format as used in gcc >= 3.3 | |
1569 while (<INPUT>) | |
1570 { | |
1571 chomp($_); | |
1572 | |
1573 # Also remove CR from line-end | |
1574 s/\015$//; | |
1575 | |
1576 if (/^\s*(\d+|\$+):\s*(\d+)-block\s+(\d+)\s*$/) { | |
1577 # Block information - used to group related | |
1578 # branches | |
1579 $last_line = $2; | |
1580 $last_block = $3; | |
1581 } elsif (/^branch\s+(\d+)\s+taken\s+(\d+)/) { | |
1582 next if ($exclude_line); | |
1583 $branches = br_gvec_push($branches, $last_line, | |
1584 $last_block, $1, $2); | |
1585 } elsif (/^branch\s+(\d+)\s+never\s+executed/) { | |
1586 next if ($exclude_line); | |
1587 $branches = br_gvec_push($branches, $last_line, | |
1588 $last_block, $1, '-'); | |
1589 } | |
1590 elsif (/^function\s+(\S+)\s+called\s+(\d+)/) | |
1591 { | |
1592 if ($exclude_line) { | |
1593 next; | |
1594 } | |
1595 push(@functions, $2, $1); | |
1596 } | |
1597 elsif (/^call/) | |
1598 { | |
1599 # Function call return data | |
1600 } | |
1601 elsif (/^\s*([^:]+):\s*([^:]+):(.*)$/) | |
1602 { | |
1603 my ($count, $line, $code) = ($1, $2, $3); | |
1604 | |
1605 $last_line = $line; | |
1606 $last_block = $UNNAMED_BLOCK; | |
1607 # Check for exclusion markers | |
1608 if (!$no_markers) { | |
1609 if (/$EXCL_STOP/) { | |
1610 $exclude_flag = 0; | |
1611 } elsif (/$EXCL_START/) { | |
1612 $exclude_flag = 1; | |
1613 } | |
1614 if (/$EXCL_LINE/ || $exclude_flag) { | |
1615 $exclude_line = 1; | |
1616 } else { | |
1617 $exclude_line = 0; | |
1618 } | |
1619 } | |
1620 # <exec count>:<line number>:<source code> | |
1621 if ($line eq "0") | |
1622 { | |
1623 # Extra data | |
1624 } | |
1625 elsif ($count eq "-") | |
1626 { | |
1627 # Uninstrumented line | |
1628 push(@result, 0); | |
1629 push(@result, 0); | |
1630 push(@result, $code); | |
1631 } | |
1632 else | |
1633 { | |
1634 if ($exclude_line) { | |
1635 push(@result, 0); | |
1636 push(@result, 0); | |
1637 } else { | |
1638 # Check for zero count | |
1639 if ($count eq "#####") { | |
1640 $count = 0; | |
1641 } | |
1642 push(@result, 1); | |
1643 push(@result, $count); | |
1644 } | |
1645 push(@result, $code); | |
1646 } | |
1647 } | |
1648 } | |
1649 } | |
1650 | |
1651 close(INPUT); | |
1652 if ($exclude_flag) { | |
1653 warn("WARNING: unterminated exclusion section in $filename\n"); | |
1654 } | |
1655 return(\@result, $branches, \@functions); | |
1656 } | |
1657 | |
1658 | |
1659 # | |
1660 # Get the GCOV tool version. Return an integer number which represents the | |
1661 # GCOV version. Version numbers can be compared using standard integer | |
1662 # operations. | |
1663 # | |
1664 | |
1665 sub get_gcov_version() | |
1666 { | |
1667 local *HANDLE; | |
1668 my $version_string; | |
1669 my $result; | |
1670 | |
1671 open(GCOV_PIPE, "$gcov_tool -v |") | |
1672 or die("ERROR: cannot retrieve gcov version!\n"); | |
1673 $version_string = <GCOV_PIPE>; | |
1674 close(GCOV_PIPE); | |
1675 | |
1676 $result = 0; | |
1677 if ($version_string =~ /(\d+)\.(\d+)(\.(\d+))?/) | |
1678 { | |
1679 if (defined($4)) | |
1680 { | |
1681 info("Found gcov version: $1.$2.$4\n"); | |
1682 $result = $1 << 16 | $2 << 8 | $4; | |
1683 } | |
1684 else | |
1685 { | |
1686 info("Found gcov version: $1.$2\n"); | |
1687 $result = $1 << 16 | $2 << 8; | |
1688 } | |
1689 } | |
1690 if ($version_string =~ /suse/i && $result == 0x30303 || | |
1691 $version_string =~ /mandrake/i && $result == 0x30302) | |
1692 { | |
1693 info("Using compatibility mode for GCC 3.3 (hammer)\n"); | |
1694 $compatibility = $COMPAT_HAMMER; | |
1695 } | |
1696 return $result; | |
1697 } | |
1698 | |
1699 | |
1700 # | |
1701 # info(printf_parameter) | |
1702 # | |
1703 # Use printf to write PRINTF_PARAMETER to stdout only when the $quiet flag | |
1704 # is not set. | |
1705 # | |
1706 | |
1707 sub info(@) | |
1708 { | |
1709 if (!$quiet) | |
1710 { | |
1711 # Print info string | |
1712 if (defined($output_filename) && ($output_filename eq "-")) | |
1713 { | |
1714 # Don't interfere with the .info output to STDOUT | |
1715 printf(STDERR @_); | |
1716 } | |
1717 else | |
1718 { | |
1719 printf(@_); | |
1720 } | |
1721 } | |
1722 } | |
1723 | |
1724 | |
1725 # | |
1726 # int_handler() | |
1727 # | |
1728 # Called when the script was interrupted by an INT signal (e.g. CTRl-C) | |
1729 # | |
1730 | |
1731 sub int_handler() | |
1732 { | |
1733 if ($cwd) { chdir($cwd); } | |
1734 info("Aborted.\n"); | |
1735 exit(1); | |
1736 } | |
1737 | |
1738 | |
1739 # | |
1740 # system_no_output(mode, parameters) | |
1741 # | |
1742 # Call an external program using PARAMETERS while suppressing depending on | |
1743 # the value of MODE: | |
1744 # | |
1745 # MODE & 1: suppress STDOUT | |
1746 # MODE & 2: suppress STDERR | |
1747 # | |
1748 # Return 0 on success, non-zero otherwise. | |
1749 # | |
1750 | |
1751 sub system_no_output($@) | |
1752 { | |
1753 my $mode = shift; | |
1754 my $result; | |
1755 local *OLD_STDERR; | |
1756 local *OLD_STDOUT; | |
1757 | |
1758 # Save old stdout and stderr handles | |
1759 ($mode & 1) && open(OLD_STDOUT, ">>&STDOUT"); | |
1760 ($mode & 2) && open(OLD_STDERR, ">>&STDERR"); | |
1761 | |
1762 # Redirect to /dev/null | |
1763 ($mode & 1) && open(STDOUT, ">/dev/null"); | |
1764 ($mode & 2) && open(STDERR, ">/dev/null"); | |
1765 | |
1766 system(@_); | |
1767 $result = $?; | |
1768 | |
1769 # Close redirected handles | |
1770 ($mode & 1) && close(STDOUT); | |
1771 ($mode & 2) && close(STDERR); | |
1772 | |
1773 # Restore old handles | |
1774 ($mode & 1) && open(STDOUT, ">>&OLD_STDOUT"); | |
1775 ($mode & 2) && open(STDERR, ">>&OLD_STDERR"); | |
1776 | |
1777 return $result; | |
1778 } | |
1779 | |
1780 | |
1781 # | |
1782 # read_config(filename) | |
1783 # | |
1784 # Read configuration file FILENAME and return a reference to a hash containing | |
1785 # all valid key=value pairs found. | |
1786 # | |
1787 | |
1788 sub read_config($) | |
1789 { | |
1790 my $filename = $_[0]; | |
1791 my %result; | |
1792 my $key; | |
1793 my $value; | |
1794 local *HANDLE; | |
1795 | |
1796 if (!open(HANDLE, "<$filename")) | |
1797 { | |
1798 warn("WARNING: cannot read configuration file $filename\n"); | |
1799 return undef; | |
1800 } | |
1801 while (<HANDLE>) | |
1802 { | |
1803 chomp; | |
1804 # Skip comments | |
1805 s/#.*//; | |
1806 # Remove leading blanks | |
1807 s/^\s+//; | |
1808 # Remove trailing blanks | |
1809 s/\s+$//; | |
1810 next unless length; | |
1811 ($key, $value) = split(/\s*=\s*/, $_, 2); | |
1812 if (defined($key) && defined($value)) | |
1813 { | |
1814 $result{$key} = $value; | |
1815 } | |
1816 else | |
1817 { | |
1818 warn("WARNING: malformed statement in line $. ". | |
1819 "of configuration file $filename\n"); | |
1820 } | |
1821 } | |
1822 close(HANDLE); | |
1823 return \%result; | |
1824 } | |
1825 | |
1826 | |
1827 # | |
1828 # apply_config(REF) | |
1829 # | |
1830 # REF is a reference to a hash containing the following mapping: | |
1831 # | |
1832 # key_string => var_ref | |
1833 # | |
1834 # where KEY_STRING is a keyword and VAR_REF is a reference to an associated | |
1835 # variable. If the global configuration hash CONFIG contains a value for | |
1836 # keyword KEY_STRING, VAR_REF will be assigned the value for that keyword. | |
1837 # | |
1838 | |
1839 sub apply_config($) | |
1840 { | |
1841 my $ref = $_[0]; | |
1842 | |
1843 foreach (keys(%{$ref})) | |
1844 { | |
1845 if (defined($config->{$_})) | |
1846 { | |
1847 ${$ref->{$_}} = $config->{$_}; | |
1848 } | |
1849 } | |
1850 } | |
1851 | |
1852 | |
1853 # | |
1854 # get_exclusion_data(filename) | |
1855 # | |
1856 # Scan specified source code file for exclusion markers and return | |
1857 # linenumber -> 1 | |
1858 # for all lines which should be excluded. | |
1859 # | |
1860 | |
1861 sub get_exclusion_data($) | |
1862 { | |
1863 my ($filename) = @_; | |
1864 my %list; | |
1865 my $flag = 0; | |
1866 local *HANDLE; | |
1867 | |
1868 if (!open(HANDLE, "<$filename")) { | |
1869 warn("WARNING: could not open $filename\n"); | |
1870 return undef; | |
1871 } | |
1872 while (<HANDLE>) { | |
1873 if (/$EXCL_STOP/) { | |
1874 $flag = 0; | |
1875 } elsif (/$EXCL_START/) { | |
1876 $flag = 1; | |
1877 } | |
1878 if (/$EXCL_LINE/ || $flag) { | |
1879 $list{$.} = 1; | |
1880 } | |
1881 } | |
1882 close(HANDLE); | |
1883 | |
1884 if ($flag) { | |
1885 warn("WARNING: unterminated exclusion section in $filename\n"); | |
1886 } | |
1887 | |
1888 return \%list; | |
1889 } | |
1890 | |
1891 | |
1892 # | |
1893 # apply_exclusion_data(instr, graph) | |
1894 # | |
1895 # Remove lines from instr and graph data structures which are marked | |
1896 # for exclusion in the source code file. | |
1897 # | |
1898 # Return adjusted (instr, graph). | |
1899 # | |
1900 # graph : file name -> function data | |
1901 # function data : function name -> line data | |
1902 # line data : [ line1, line2, ... ] | |
1903 # | |
1904 # instr : filename -> line data | |
1905 # line data : [ line1, line2, ... ] | |
1906 # | |
1907 | |
1908 sub apply_exclusion_data($$) | |
1909 { | |
1910 my ($instr, $graph) = @_; | |
1911 my $filename; | |
1912 my %excl_data; | |
1913 my $excl_read_failed = 0; | |
1914 | |
1915 # Collect exclusion marker data | |
1916 foreach $filename (sort_uniq_lex(keys(%{$graph}), keys(%{$instr}))) { | |
1917 my $excl = get_exclusion_data($filename); | |
1918 | |
1919 # Skip and note if file could not be read | |
1920 if (!defined($excl)) { | |
1921 $excl_read_failed = 1; | |
1922 next; | |
1923 } | |
1924 | |
1925 # Add to collection if there are markers | |
1926 $excl_data{$filename} = $excl if (keys(%{$excl}) > 0); | |
1927 } | |
1928 | |
1929 # Warn if not all source files could be read | |
1930 if ($excl_read_failed) { | |
1931 warn("WARNING: some exclusion markers may be ignored\n"); | |
1932 } | |
1933 | |
1934 # Skip if no markers were found | |
1935 return ($instr, $graph) if (keys(%excl_data) == 0); | |
1936 | |
1937 # Apply exclusion marker data to graph | |
1938 foreach $filename (keys(%excl_data)) { | |
1939 my $function_data = $graph->{$filename}; | |
1940 my $excl = $excl_data{$filename}; | |
1941 my $function; | |
1942 | |
1943 next if (!defined($function_data)); | |
1944 | |
1945 foreach $function (keys(%{$function_data})) { | |
1946 my $line_data = $function_data->{$function}; | |
1947 my $line; | |
1948 my @new_data; | |
1949 | |
1950 # To be consistent with exclusion parser in non-initial | |
1951 # case we need to remove a function if the first line | |
1952 # was excluded | |
1953 if ($excl->{$line_data->[0]}) { | |
1954 delete($function_data->{$function}); | |
1955 next; | |
1956 } | |
1957 # Copy only lines which are not excluded | |
1958 foreach $line (@{$line_data}) { | |
1959 push(@new_data, $line) if (!$excl->{$line}); | |
1960 } | |
1961 | |
1962 # Store modified list | |
1963 if (scalar(@new_data) > 0) { | |
1964 $function_data->{$function} = \@new_data; | |
1965 } else { | |
1966 # All of this function was excluded | |
1967 delete($function_data->{$function}); | |
1968 } | |
1969 } | |
1970 | |
1971 # Check if all functions of this file were excluded | |
1972 if (keys(%{$function_data}) == 0) { | |
1973 delete($graph->{$filename}); | |
1974 } | |
1975 } | |
1976 | |
1977 # Apply exclusion marker data to instr | |
1978 foreach $filename (keys(%excl_data)) { | |
1979 my $line_data = $instr->{$filename}; | |
1980 my $excl = $excl_data{$filename}; | |
1981 my $line; | |
1982 my @new_data; | |
1983 | |
1984 next if (!defined($line_data)); | |
1985 | |
1986 # Copy only lines which are not excluded | |
1987 foreach $line (@{$line_data}) { | |
1988 push(@new_data, $line) if (!$excl->{$line}); | |
1989 } | |
1990 | |
1991 # Store modified list | |
1992 if (scalar(@new_data) > 0) { | |
1993 $instr->{$filename} = \@new_data; | |
1994 } else { | |
1995 # All of this file was excluded | |
1996 delete($instr->{$filename}); | |
1997 } | |
1998 } | |
1999 | |
2000 return ($instr, $graph); | |
2001 } | |
2002 | |
2003 | |
2004 sub process_graphfile($$) | |
2005 { | |
2006 my ($file, $dir) = @_; | |
2007 my $graph_filename = $file; | |
2008 my $graph_dir; | |
2009 my $graph_basename; | |
2010 my $source_dir; | |
2011 my $base_dir; | |
2012 my $graph; | |
2013 my $instr; | |
2014 my $filename; | |
2015 local *INFO_HANDLE; | |
2016 | |
2017 info("Processing %s\n", abs2rel($file, $dir)); | |
2018 | |
2019 # Get path to data file in absolute and normalized form (begins with /, | |
2020 # contains no more ../ or ./) | |
2021 $graph_filename = solve_relative_path($cwd, $graph_filename); | |
2022 | |
2023 # Get directory and basename of data file | |
2024 ($graph_dir, $graph_basename) = split_filename($graph_filename); | |
2025 | |
2026 # avoid files from .libs dirs | |
2027 if ($compat_libtool && $graph_dir =~ m/(.*)\/\.libs$/) { | |
2028 $source_dir = $1; | |
2029 } else { | |
2030 $source_dir = $graph_dir; | |
2031 } | |
2032 | |
2033 # Construct base_dir for current file | |
2034 if ($base_directory) | |
2035 { | |
2036 $base_dir = $base_directory; | |
2037 } | |
2038 else | |
2039 { | |
2040 $base_dir = $source_dir; | |
2041 } | |
2042 | |
2043 if ($gcov_version < $GCOV_VERSION_3_4_0) | |
2044 { | |
2045 if (defined($compatibility) && $compatibility eq $COMPAT_HAMMER) | |
2046 { | |
2047 ($instr, $graph) = read_bbg($graph_filename, $base_dir); | |
2048 } | |
2049 else | |
2050 { | |
2051 ($instr, $graph) = read_bb($graph_filename, $base_dir); | |
2052 } | |
2053 } | |
2054 else | |
2055 { | |
2056 ($instr, $graph) = read_gcno($graph_filename, $base_dir); | |
2057 } | |
2058 | |
2059 if (!$no_markers) { | |
2060 # Apply exclusion marker data to graph file data | |
2061 ($instr, $graph) = apply_exclusion_data($instr, $graph); | |
2062 } | |
2063 | |
2064 # Check whether we're writing to a single file | |
2065 if ($output_filename) | |
2066 { | |
2067 if ($output_filename eq "-") | |
2068 { | |
2069 *INFO_HANDLE = *STDOUT; | |
2070 } | |
2071 else | |
2072 { | |
2073 # Append to output file | |
2074 open(INFO_HANDLE, ">>$output_filename") | |
2075 or die("ERROR: cannot write to ". | |
2076 "$output_filename!\n"); | |
2077 } | |
2078 } | |
2079 else | |
2080 { | |
2081 # Open .info file for output | |
2082 open(INFO_HANDLE, ">$graph_filename.info") | |
2083 or die("ERROR: cannot create $graph_filename.info!\n"); | |
2084 } | |
2085 | |
2086 # Write test name | |
2087 printf(INFO_HANDLE "TN:%s\n", $test_name); | |
2088 foreach $filename (sort(keys(%{$instr}))) | |
2089 { | |
2090 my $funcdata = $graph->{$filename}; | |
2091 my $line; | |
2092 my $linedata; | |
2093 | |
2094 print(INFO_HANDLE "SF:$filename\n"); | |
2095 | |
2096 if (defined($funcdata)) { | |
2097 my @functions = sort {$funcdata->{$a}->[0] <=> | |
2098 $funcdata->{$b}->[0]} | |
2099 keys(%{$funcdata}); | |
2100 my $func; | |
2101 | |
2102 # Gather list of instrumented lines and functions | |
2103 foreach $func (@functions) { | |
2104 $linedata = $funcdata->{$func}; | |
2105 | |
2106 # Print function name and starting line | |
2107 print(INFO_HANDLE "FN:".$linedata->[0]. | |
2108 ",".filter_fn_name($func)."\n"); | |
2109 } | |
2110 # Print zero function coverage data | |
2111 foreach $func (@functions) { | |
2112 print(INFO_HANDLE "FNDA:0,". | |
2113 filter_fn_name($func)."\n"); | |
2114 } | |
2115 # Print function summary | |
2116 print(INFO_HANDLE "FNF:".scalar(@functions)."\n"); | |
2117 print(INFO_HANDLE "FNH:0\n"); | |
2118 } | |
2119 # Print zero line coverage data | |
2120 foreach $line (@{$instr->{$filename}}) { | |
2121 print(INFO_HANDLE "DA:$line,0\n"); | |
2122 } | |
2123 # Print line summary | |
2124 print(INFO_HANDLE "LF:".scalar(@{$instr->{$filename}})."\n"); | |
2125 print(INFO_HANDLE "LH:0\n"); | |
2126 | |
2127 print(INFO_HANDLE "end_of_record\n"); | |
2128 } | |
2129 if (!($output_filename && ($output_filename eq "-"))) | |
2130 { | |
2131 close(INFO_HANDLE); | |
2132 } | |
2133 } | |
2134 | |
2135 sub filter_fn_name($) | |
2136 { | |
2137 my ($fn) = @_; | |
2138 | |
2139 # Remove characters used internally as function name delimiters | |
2140 $fn =~ s/[,=]/_/g; | |
2141 | |
2142 return $fn; | |
2143 } | |
2144 | |
2145 sub warn_handler($) | |
2146 { | |
2147 my ($msg) = @_; | |
2148 | |
2149 warn("$tool_name: $msg"); | |
2150 } | |
2151 | |
2152 sub die_handler($) | |
2153 { | |
2154 my ($msg) = @_; | |
2155 | |
2156 die("$tool_name: $msg"); | |
2157 } | |
2158 | |
2159 | |
2160 # | |
2161 # graph_error(filename, message) | |
2162 # | |
2163 # Print message about error in graph file. If ignore_graph_error is set, return. | |
2164 # Otherwise abort. | |
2165 # | |
2166 | |
2167 sub graph_error($$) | |
2168 { | |
2169 my ($filename, $msg) = @_; | |
2170 | |
2171 if ($ignore[$ERROR_GRAPH]) { | |
2172 warn("WARNING: $filename: $msg - skipping\n"); | |
2173 return; | |
2174 } | |
2175 die("ERROR: $filename: $msg\n"); | |
2176 } | |
2177 | |
2178 # | |
2179 # graph_expect(description) | |
2180 # | |
2181 # If debug is set to a non-zero value, print the specified description of what | |
2182 # is expected to be read next from the graph file. | |
2183 # | |
2184 | |
2185 sub graph_expect($) | |
2186 { | |
2187 my ($msg) = @_; | |
2188 | |
2189 if (!$debug || !defined($msg)) { | |
2190 return; | |
2191 } | |
2192 | |
2193 print(STDERR "DEBUG: expecting $msg\n"); | |
2194 } | |
2195 | |
2196 # | |
2197 # graph_read(handle, bytes[, description]) | |
2198 # | |
2199 # Read and return the specified number of bytes from handle. Return undef | |
2200 # if the number of bytes could not be read. | |
2201 # | |
2202 | |
2203 sub graph_read(*$;$) | |
2204 { | |
2205 my ($handle, $length, $desc) = @_; | |
2206 my $data; | |
2207 my $result; | |
2208 | |
2209 graph_expect($desc); | |
2210 $result = read($handle, $data, $length); | |
2211 if ($debug) { | |
2212 my $ascii = ""; | |
2213 my $hex = ""; | |
2214 my $i; | |
2215 | |
2216 print(STDERR "DEBUG: read($length)=$result: "); | |
2217 for ($i = 0; $i < length($data); $i++) { | |
2218 my $c = substr($data, $i, 1);; | |
2219 my $n = ord($c); | |
2220 | |
2221 $hex .= sprintf("%02x ", $n); | |
2222 if ($n >= 32 && $n <= 127) { | |
2223 $ascii .= $c; | |
2224 } else { | |
2225 $ascii .= "."; | |
2226 } | |
2227 } | |
2228 print(STDERR "$hex |$ascii|"); | |
2229 print(STDERR "\n"); | |
2230 } | |
2231 if ($result != $length) { | |
2232 return undef; | |
2233 } | |
2234 return $data; | |
2235 } | |
2236 | |
2237 # | |
2238 # graph_skip(handle, bytes[, description]) | |
2239 # | |
2240 # Read and discard the specified number of bytes from handle. Return non-zero | |
2241 # if bytes could be read, zero otherwise. | |
2242 # | |
2243 | |
2244 sub graph_skip(*$;$) | |
2245 { | |
2246 my ($handle, $length, $desc) = @_; | |
2247 | |
2248 if (defined(graph_read($handle, $length, $desc))) { | |
2249 return 1; | |
2250 } | |
2251 return 0; | |
2252 } | |
2253 | |
2254 # | |
2255 # sort_uniq(list) | |
2256 # | |
2257 # Return list in numerically ascending order and without duplicate entries. | |
2258 # | |
2259 | |
2260 sub sort_uniq(@) | |
2261 { | |
2262 my (@list) = @_; | |
2263 my %hash; | |
2264 | |
2265 foreach (@list) { | |
2266 $hash{$_} = 1; | |
2267 } | |
2268 return sort { $a <=> $b } keys(%hash); | |
2269 } | |
2270 | |
2271 # | |
2272 # sort_uniq_lex(list) | |
2273 # | |
2274 # Return list in lexically ascending order and without duplicate entries. | |
2275 # | |
2276 | |
2277 sub sort_uniq_lex(@) | |
2278 { | |
2279 my (@list) = @_; | |
2280 my %hash; | |
2281 | |
2282 foreach (@list) { | |
2283 $hash{$_} = 1; | |
2284 } | |
2285 return sort keys(%hash); | |
2286 } | |
2287 | |
2288 # | |
2289 # graph_cleanup(graph) | |
2290 # | |
2291 # Remove entries for functions with no lines. Remove duplicate line numbers. | |
2292 # Sort list of line numbers numerically ascending. | |
2293 # | |
2294 | |
2295 sub graph_cleanup($) | |
2296 { | |
2297 my ($graph) = @_; | |
2298 my $filename; | |
2299 | |
2300 foreach $filename (keys(%{$graph})) { | |
2301 my $per_file = $graph->{$filename}; | |
2302 my $function; | |
2303 | |
2304 foreach $function (keys(%{$per_file})) { | |
2305 my $lines = $per_file->{$function}; | |
2306 | |
2307 if (scalar(@$lines) == 0) { | |
2308 # Remove empty function | |
2309 delete($per_file->{$function}); | |
2310 next; | |
2311 } | |
2312 # Normalize list | |
2313 $per_file->{$function} = [ sort_uniq(@$lines) ]; | |
2314 } | |
2315 if (scalar(keys(%{$per_file})) == 0) { | |
2316 # Remove empty file | |
2317 delete($graph->{$filename}); | |
2318 } | |
2319 } | |
2320 } | |
2321 | |
2322 # | |
2323 # graph_find_base(bb) | |
2324 # | |
2325 # Try to identify the filename which is the base source file for the | |
2326 # specified bb data. | |
2327 # | |
2328 | |
2329 sub graph_find_base($) | |
2330 { | |
2331 my ($bb) = @_; | |
2332 my %file_count; | |
2333 my $basefile; | |
2334 my $file; | |
2335 my $func; | |
2336 my $filedata; | |
2337 my $count; | |
2338 my $num; | |
2339 | |
2340 # Identify base name for this bb data. | |
2341 foreach $func (keys(%{$bb})) { | |
2342 $filedata = $bb->{$func}; | |
2343 | |
2344 foreach $file (keys(%{$filedata})) { | |
2345 $count = $file_count{$file}; | |
2346 | |
2347 # Count file occurrence | |
2348 $file_count{$file} = defined($count) ? $count + 1 : 1; | |
2349 } | |
2350 } | |
2351 $count = 0; | |
2352 $num = 0; | |
2353 foreach $file (keys(%file_count)) { | |
2354 if ($file_count{$file} > $count) { | |
2355 # The file that contains code for the most functions | |
2356 # is likely the base file | |
2357 $count = $file_count{$file}; | |
2358 $num = 1; | |
2359 $basefile = $file; | |
2360 } elsif ($file_count{$file} == $count) { | |
2361 # If more than one file could be the basefile, we | |
2362 # don't have a basefile | |
2363 $basefile = undef; | |
2364 } | |
2365 } | |
2366 | |
2367 return $basefile; | |
2368 } | |
2369 | |
2370 # | |
2371 # graph_from_bb(bb, fileorder, bb_filename) | |
2372 # | |
2373 # Convert data from bb to the graph format and list of instrumented lines. | |
2374 # Returns (instr, graph). | |
2375 # | |
2376 # bb : function name -> file data | |
2377 # : undef -> file order | |
2378 # file data : filename -> line data | |
2379 # line data : [ line1, line2, ... ] | |
2380 # | |
2381 # file order : function name -> [ filename1, filename2, ... ] | |
2382 # | |
2383 # graph : file name -> function data | |
2384 # function data : function name -> line data | |
2385 # line data : [ line1, line2, ... ] | |
2386 # | |
2387 # instr : filename -> line data | |
2388 # line data : [ line1, line2, ... ] | |
2389 # | |
2390 | |
2391 sub graph_from_bb($$$) | |
2392 { | |
2393 my ($bb, $fileorder, $bb_filename) = @_; | |
2394 my $graph = {}; | |
2395 my $instr = {}; | |
2396 my $basefile; | |
2397 my $file; | |
2398 my $func; | |
2399 my $filedata; | |
2400 my $linedata; | |
2401 my $order; | |
2402 | |
2403 $basefile = graph_find_base($bb); | |
2404 # Create graph structure | |
2405 foreach $func (keys(%{$bb})) { | |
2406 $filedata = $bb->{$func}; | |
2407 $order = $fileorder->{$func}; | |
2408 | |
2409 # Account for lines in functions | |
2410 if (defined($basefile) && defined($filedata->{$basefile})) { | |
2411 # If the basefile contributes to this function, | |
2412 # account this function to the basefile. | |
2413 $graph->{$basefile}->{$func} = $filedata->{$basefile}; | |
2414 } else { | |
2415 # If the basefile does not contribute to this function, | |
2416 # account this function to the first file contributing | |
2417 # lines. | |
2418 $graph->{$order->[0]}->{$func} = | |
2419 $filedata->{$order->[0]}; | |
2420 } | |
2421 | |
2422 foreach $file (keys(%{$filedata})) { | |
2423 # Account for instrumented lines | |
2424 $linedata = $filedata->{$file}; | |
2425 push(@{$instr->{$file}}, @$linedata); | |
2426 } | |
2427 } | |
2428 # Clean up array of instrumented lines | |
2429 foreach $file (keys(%{$instr})) { | |
2430 $instr->{$file} = [ sort_uniq(@{$instr->{$file}}) ]; | |
2431 } | |
2432 | |
2433 return ($instr, $graph); | |
2434 } | |
2435 | |
2436 # | |
2437 # graph_add_order(fileorder, function, filename) | |
2438 # | |
2439 # Add an entry for filename to the fileorder data set for function. | |
2440 # | |
2441 | |
2442 sub graph_add_order($$$) | |
2443 { | |
2444 my ($fileorder, $function, $filename) = @_; | |
2445 my $item; | |
2446 my $list; | |
2447 | |
2448 $list = $fileorder->{$function}; | |
2449 foreach $item (@$list) { | |
2450 if ($item eq $filename) { | |
2451 return; | |
2452 } | |
2453 } | |
2454 push(@$list, $filename); | |
2455 $fileorder->{$function} = $list; | |
2456 } | |
2457 # | |
2458 # read_bb_word(handle[, description]) | |
2459 # | |
2460 # Read and return a word in .bb format from handle. | |
2461 # | |
2462 | |
2463 sub read_bb_word(*;$) | |
2464 { | |
2465 my ($handle, $desc) = @_; | |
2466 | |
2467 return graph_read($handle, 4, $desc); | |
2468 } | |
2469 | |
2470 # | |
2471 # read_bb_value(handle[, description]) | |
2472 # | |
2473 # Read a word in .bb format from handle and return the word and its integer | |
2474 # value. | |
2475 # | |
2476 | |
2477 sub read_bb_value(*;$) | |
2478 { | |
2479 my ($handle, $desc) = @_; | |
2480 my $word; | |
2481 | |
2482 $word = read_bb_word($handle, $desc); | |
2483 return undef if (!defined($word)); | |
2484 | |
2485 return ($word, unpack("V", $word)); | |
2486 } | |
2487 | |
2488 # | |
2489 # read_bb_string(handle, delimiter) | |
2490 # | |
2491 # Read and return a string in .bb format from handle up to the specified | |
2492 # delimiter value. | |
2493 # | |
2494 | |
2495 sub read_bb_string(*$) | |
2496 { | |
2497 my ($handle, $delimiter) = @_; | |
2498 my $word; | |
2499 my $value; | |
2500 my $string = ""; | |
2501 | |
2502 graph_expect("string"); | |
2503 do { | |
2504 ($word, $value) = read_bb_value($handle, "string or delimiter"); | |
2505 return undef if (!defined($value)); | |
2506 if ($value != $delimiter) { | |
2507 $string .= $word; | |
2508 } | |
2509 } while ($value != $delimiter); | |
2510 $string =~ s/\0//g; | |
2511 | |
2512 return $string; | |
2513 } | |
2514 | |
2515 # | |
2516 # read_bb(filename, base_dir) | |
2517 # | |
2518 # Read the contents of the specified .bb file and return (instr, graph), where: | |
2519 # | |
2520 # instr : filename -> line data | |
2521 # line data : [ line1, line2, ... ] | |
2522 # | |
2523 # graph : filename -> file_data | |
2524 # file_data : function name -> line_data | |
2525 # line_data : [ line1, line2, ... ] | |
2526 # | |
2527 # Relative filenames are converted to absolute form using base_dir as | |
2528 # base directory. See the gcov info pages of gcc 2.95 for a description of | |
2529 # the .bb file format. | |
2530 # | |
2531 | |
2532 sub read_bb($$) | |
2533 { | |
2534 my ($bb_filename, $base) = @_; | |
2535 my $minus_one = 0x80000001; | |
2536 my $minus_two = 0x80000002; | |
2537 my $value; | |
2538 my $filename; | |
2539 my $function; | |
2540 my $bb = {}; | |
2541 my $fileorder = {}; | |
2542 my $instr; | |
2543 my $graph; | |
2544 local *HANDLE; | |
2545 | |
2546 open(HANDLE, "<$bb_filename") or goto open_error; | |
2547 binmode(HANDLE); | |
2548 while (!eof(HANDLE)) { | |
2549 $value = read_bb_value(*HANDLE, "data word"); | |
2550 goto incomplete if (!defined($value)); | |
2551 if ($value == $minus_one) { | |
2552 # Source file name | |
2553 graph_expect("filename"); | |
2554 $filename = read_bb_string(*HANDLE, $minus_one); | |
2555 goto incomplete if (!defined($filename)); | |
2556 if ($filename ne "") { | |
2557 $filename = solve_relative_path($base, | |
2558 $filename); | |
2559 } | |
2560 } elsif ($value == $minus_two) { | |
2561 # Function name | |
2562 graph_expect("function name"); | |
2563 $function = read_bb_string(*HANDLE, $minus_two); | |
2564 goto incomplete if (!defined($function)); | |
2565 } elsif ($value > 0) { | |
2566 # Line number | |
2567 if (!defined($filename) || !defined($function)) { | |
2568 warn("WARNING: unassigned line number ". | |
2569 "$value\n"); | |
2570 next; | |
2571 } | |
2572 push(@{$bb->{$function}->{$filename}}, $value); | |
2573 graph_add_order($fileorder, $function, $filename); | |
2574 } | |
2575 } | |
2576 close(HANDLE); | |
2577 ($instr, $graph) = graph_from_bb($bb, $fileorder, $bb_filename); | |
2578 graph_cleanup($graph); | |
2579 | |
2580 return ($instr, $graph); | |
2581 | |
2582 open_error: | |
2583 graph_error($bb_filename, "could not open file"); | |
2584 return undef; | |
2585 incomplete: | |
2586 graph_error($bb_filename, "reached unexpected end of file"); | |
2587 return undef; | |
2588 } | |
2589 | |
2590 # | |
2591 # read_bbg_word(handle[, description]) | |
2592 # | |
2593 # Read and return a word in .bbg format. | |
2594 # | |
2595 | |
2596 sub read_bbg_word(*;$) | |
2597 { | |
2598 my ($handle, $desc) = @_; | |
2599 | |
2600 return graph_read($handle, 4, $desc); | |
2601 } | |
2602 | |
2603 # | |
2604 # read_bbg_value(handle[, description]) | |
2605 # | |
2606 # Read a word in .bbg format from handle and return its integer value. | |
2607 # | |
2608 | |
2609 sub read_bbg_value(*;$) | |
2610 { | |
2611 my ($handle, $desc) = @_; | |
2612 my $word; | |
2613 | |
2614 $word = read_bbg_word($handle, $desc); | |
2615 return undef if (!defined($word)); | |
2616 | |
2617 return unpack("N", $word); | |
2618 } | |
2619 | |
2620 # | |
2621 # read_bbg_string(handle) | |
2622 # | |
2623 # Read and return a string in .bbg format. | |
2624 # | |
2625 | |
2626 sub read_bbg_string(*) | |
2627 { | |
2628 my ($handle, $desc) = @_; | |
2629 my $length; | |
2630 my $string; | |
2631 | |
2632 graph_expect("string"); | |
2633 # Read string length | |
2634 $length = read_bbg_value($handle, "string length"); | |
2635 return undef if (!defined($length)); | |
2636 if ($length == 0) { | |
2637 return ""; | |
2638 } | |
2639 # Read string | |
2640 $string = graph_read($handle, $length, "string"); | |
2641 return undef if (!defined($string)); | |
2642 # Skip padding | |
2643 graph_skip($handle, 4 - $length % 4, "string padding") or return undef; | |
2644 | |
2645 return $string; | |
2646 } | |
2647 | |
2648 # | |
2649 # read_bbg_lines_record(handle, bbg_filename, bb, fileorder, filename, | |
2650 # function, base) | |
2651 # | |
2652 # Read a bbg format lines record from handle and add the relevant data to | |
2653 # bb and fileorder. Return filename on success, undef on error. | |
2654 # | |
2655 | |
2656 sub read_bbg_lines_record(*$$$$$$) | |
2657 { | |
2658 my ($handle, $bbg_filename, $bb, $fileorder, $filename, $function, | |
2659 $base) = @_; | |
2660 my $string; | |
2661 my $lineno; | |
2662 | |
2663 graph_expect("lines record"); | |
2664 # Skip basic block index | |
2665 graph_skip($handle, 4, "basic block index") or return undef; | |
2666 while (1) { | |
2667 # Read line number | |
2668 $lineno = read_bbg_value($handle, "line number"); | |
2669 return undef if (!defined($lineno)); | |
2670 if ($lineno == 0) { | |
2671 # Got a marker for a new filename | |
2672 graph_expect("filename"); | |
2673 $string = read_bbg_string($handle); | |
2674 return undef if (!defined($string)); | |
2675 # Check for end of record | |
2676 if ($string eq "") { | |
2677 return $filename; | |
2678 } | |
2679 $filename = solve_relative_path($base, $string); | |
2680 next; | |
2681 } | |
2682 # Got an actual line number | |
2683 if (!defined($filename)) { | |
2684 warn("WARNING: unassigned line number in ". | |
2685 "$bbg_filename\n"); | |
2686 next; | |
2687 } | |
2688 push(@{$bb->{$function}->{$filename}}, $lineno); | |
2689 graph_add_order($fileorder, $function, $filename); | |
2690 } | |
2691 } | |
2692 | |
2693 # | |
2694 # read_bbg(filename, base_dir) | |
2695 # | |
2696 # Read the contents of the specified .bbg file and return the following mapping: | |
2697 # graph: filename -> file_data | |
2698 # file_data: function name -> line_data | |
2699 # line_data: [ line1, line2, ... ] | |
2700 # | |
2701 # Relative filenames are converted to absolute form using base_dir as | |
2702 # base directory. See the gcov-io.h file in the SLES 9 gcc 3.3.3 source code | |
2703 # for a description of the .bbg format. | |
2704 # | |
2705 | |
2706 sub read_bbg($$) | |
2707 { | |
2708 my ($bbg_filename, $base) = @_; | |
2709 my $file_magic = 0x67626267; | |
2710 my $tag_function = 0x01000000; | |
2711 my $tag_lines = 0x01450000; | |
2712 my $word; | |
2713 my $tag; | |
2714 my $length; | |
2715 my $function; | |
2716 my $filename; | |
2717 my $bb = {}; | |
2718 my $fileorder = {}; | |
2719 my $instr; | |
2720 my $graph; | |
2721 local *HANDLE; | |
2722 | |
2723 open(HANDLE, "<$bbg_filename") or goto open_error; | |
2724 binmode(HANDLE); | |
2725 # Read magic | |
2726 $word = read_bbg_value(*HANDLE, "file magic"); | |
2727 goto incomplete if (!defined($word)); | |
2728 # Check magic | |
2729 if ($word != $file_magic) { | |
2730 goto magic_error; | |
2731 } | |
2732 # Skip version | |
2733 graph_skip(*HANDLE, 4, "version") or goto incomplete; | |
2734 while (!eof(HANDLE)) { | |
2735 # Read record tag | |
2736 $tag = read_bbg_value(*HANDLE, "record tag"); | |
2737 goto incomplete if (!defined($tag)); | |
2738 # Read record length | |
2739 $length = read_bbg_value(*HANDLE, "record length"); | |
2740 goto incomplete if (!defined($tag)); | |
2741 if ($tag == $tag_function) { | |
2742 graph_expect("function record"); | |
2743 # Read function name | |
2744 graph_expect("function name"); | |
2745 $function = read_bbg_string(*HANDLE); | |
2746 goto incomplete if (!defined($function)); | |
2747 $filename = undef; | |
2748 # Skip function checksum | |
2749 graph_skip(*HANDLE, 4, "function checksum") | |
2750 or goto incomplete; | |
2751 } elsif ($tag == $tag_lines) { | |
2752 # Read lines record | |
2753 $filename = read_bbg_lines_record(HANDLE, $bbg_filename, | |
2754 $bb, $fileorder, $filename, | |
2755 $function, $base); | |
2756 goto incomplete if (!defined($filename)); | |
2757 } else { | |
2758 # Skip record contents | |
2759 graph_skip(*HANDLE, $length, "unhandled record") | |
2760 or goto incomplete; | |
2761 } | |
2762 } | |
2763 close(HANDLE); | |
2764 ($instr, $graph) = graph_from_bb($bb, $fileorder, $bbg_filename); | |
2765 graph_cleanup($graph); | |
2766 | |
2767 return ($instr, $graph); | |
2768 | |
2769 open_error: | |
2770 graph_error($bbg_filename, "could not open file"); | |
2771 return undef; | |
2772 incomplete: | |
2773 graph_error($bbg_filename, "reached unexpected end of file"); | |
2774 return undef; | |
2775 magic_error: | |
2776 graph_error($bbg_filename, "found unrecognized bbg file magic"); | |
2777 return undef; | |
2778 } | |
2779 | |
2780 # | |
2781 # read_gcno_word(handle[, description]) | |
2782 # | |
2783 # Read and return a word in .gcno format. | |
2784 # | |
2785 | |
2786 sub read_gcno_word(*;$) | |
2787 { | |
2788 my ($handle, $desc) = @_; | |
2789 | |
2790 return graph_read($handle, 4, $desc); | |
2791 } | |
2792 | |
2793 # | |
2794 # read_gcno_value(handle, big_endian[, description]) | |
2795 # | |
2796 # Read a word in .gcno format from handle and return its integer value | |
2797 # according to the specified endianness. | |
2798 # | |
2799 | |
2800 sub read_gcno_value(*$;$) | |
2801 { | |
2802 my ($handle, $big_endian, $desc) = @_; | |
2803 my $word; | |
2804 | |
2805 $word = read_gcno_word($handle, $desc); | |
2806 return undef if (!defined($word)); | |
2807 if ($big_endian) { | |
2808 return unpack("N", $word); | |
2809 } else { | |
2810 return unpack("V", $word); | |
2811 } | |
2812 } | |
2813 | |
2814 # | |
2815 # read_gcno_string(handle, big_endian) | |
2816 # | |
2817 # Read and return a string in .gcno format. | |
2818 # | |
2819 | |
2820 sub read_gcno_string(*$) | |
2821 { | |
2822 my ($handle, $big_endian) = @_; | |
2823 my $length; | |
2824 my $string; | |
2825 | |
2826 graph_expect("string"); | |
2827 # Read string length | |
2828 $length = read_gcno_value($handle, $big_endian, "string length"); | |
2829 return undef if (!defined($length)); | |
2830 if ($length == 0) { | |
2831 return ""; | |
2832 } | |
2833 $length *= 4; | |
2834 # Read string | |
2835 $string = graph_read($handle, $length, "string and padding"); | |
2836 return undef if (!defined($string)); | |
2837 $string =~ s/\0//g; | |
2838 | |
2839 return $string; | |
2840 } | |
2841 | |
2842 # | |
2843 # read_gcno_lines_record(handle, gcno_filename, bb, fileorder, filename, | |
2844 # function, base, big_endian) | |
2845 # | |
2846 # Read a gcno format lines record from handle and add the relevant data to | |
2847 # bb and fileorder. Return filename on success, undef on error. | |
2848 # | |
2849 | |
2850 sub read_gcno_lines_record(*$$$$$$$) | |
2851 { | |
2852 my ($handle, $gcno_filename, $bb, $fileorder, $filename, $function, | |
2853 $base, $big_endian) = @_; | |
2854 my $string; | |
2855 my $lineno; | |
2856 | |
2857 graph_expect("lines record"); | |
2858 # Skip basic block index | |
2859 graph_skip($handle, 4, "basic block index") or return undef; | |
2860 while (1) { | |
2861 # Read line number | |
2862 $lineno = read_gcno_value($handle, $big_endian, "line number"); | |
2863 return undef if (!defined($lineno)); | |
2864 if ($lineno == 0) { | |
2865 # Got a marker for a new filename | |
2866 graph_expect("filename"); | |
2867 $string = read_gcno_string($handle, $big_endian); | |
2868 return undef if (!defined($string)); | |
2869 # Check for end of record | |
2870 if ($string eq "") { | |
2871 return $filename; | |
2872 } | |
2873 $filename = solve_relative_path($base, $string); | |
2874 next; | |
2875 } | |
2876 # Got an actual line number | |
2877 if (!defined($filename)) { | |
2878 warn("WARNING: unassigned line number in ". | |
2879 "$gcno_filename\n"); | |
2880 next; | |
2881 } | |
2882 # Add to list | |
2883 push(@{$bb->{$function}->{$filename}}, $lineno); | |
2884 graph_add_order($fileorder, $function, $filename); | |
2885 } | |
2886 } | |
2887 | |
2888 # | |
2889 # read_gcno_function_record(handle, graph, base, big_endian) | |
2890 # | |
2891 # Read a gcno format function record from handle and add the relevant data | |
2892 # to graph. Return (filename, function) on success, undef on error. | |
2893 # | |
2894 | |
2895 sub read_gcno_function_record(*$$$$) | |
2896 { | |
2897 my ($handle, $bb, $fileorder, $base, $big_endian) = @_; | |
2898 my $filename; | |
2899 my $function; | |
2900 my $lineno; | |
2901 my $lines; | |
2902 | |
2903 graph_expect("function record"); | |
2904 # Skip ident and checksum | |
2905 graph_skip($handle, 8, "function ident and checksum") or return undef; | |
2906 # Read function name | |
2907 graph_expect("function name"); | |
2908 $function = read_gcno_string($handle, $big_endian); | |
2909 return undef if (!defined($function)); | |
2910 # Read filename | |
2911 graph_expect("filename"); | |
2912 $filename = read_gcno_string($handle, $big_endian); | |
2913 return undef if (!defined($filename)); | |
2914 $filename = solve_relative_path($base, $filename); | |
2915 # Read first line number | |
2916 $lineno = read_gcno_value($handle, $big_endian, "initial line number"); | |
2917 return undef if (!defined($lineno)); | |
2918 # Add to list | |
2919 push(@{$bb->{$function}->{$filename}}, $lineno); | |
2920 graph_add_order($fileorder, $function, $filename); | |
2921 | |
2922 return ($filename, $function); | |
2923 } | |
2924 | |
2925 # | |
2926 # read_gcno(filename, base_dir) | |
2927 # | |
2928 # Read the contents of the specified .gcno file and return the following | |
2929 # mapping: | |
2930 # graph: filename -> file_data | |
2931 # file_data: function name -> line_data | |
2932 # line_data: [ line1, line2, ... ] | |
2933 # | |
2934 # Relative filenames are converted to absolute form using base_dir as | |
2935 # base directory. See the gcov-io.h file in the gcc 3.3 source code | |
2936 # for a description of the .gcno format. | |
2937 # | |
2938 | |
2939 sub read_gcno($$) | |
2940 { | |
2941 my ($gcno_filename, $base) = @_; | |
2942 my $file_magic = 0x67636e6f; | |
2943 my $tag_function = 0x01000000; | |
2944 my $tag_lines = 0x01450000; | |
2945 my $big_endian; | |
2946 my $word; | |
2947 my $tag; | |
2948 my $length; | |
2949 my $filename; | |
2950 my $function; | |
2951 my $bb = {}; | |
2952 my $fileorder = {}; | |
2953 my $instr; | |
2954 my $graph; | |
2955 local *HANDLE; | |
2956 | |
2957 open(HANDLE, "<$gcno_filename") or goto open_error; | |
2958 binmode(HANDLE); | |
2959 # Read magic | |
2960 $word = read_gcno_word(*HANDLE, "file magic"); | |
2961 goto incomplete if (!defined($word)); | |
2962 # Determine file endianness | |
2963 if (unpack("N", $word) == $file_magic) { | |
2964 $big_endian = 1; | |
2965 } elsif (unpack("V", $word) == $file_magic) { | |
2966 $big_endian = 0; | |
2967 } else { | |
2968 goto magic_error; | |
2969 } | |
2970 # Skip version and stamp | |
2971 graph_skip(*HANDLE, 8, "version and stamp") or goto incomplete; | |
2972 while (!eof(HANDLE)) { | |
2973 my $next_pos; | |
2974 my $curr_pos; | |
2975 | |
2976 # Read record tag | |
2977 $tag = read_gcno_value(*HANDLE, $big_endian, "record tag"); | |
2978 goto incomplete if (!defined($tag)); | |
2979 # Read record length | |
2980 $length = read_gcno_value(*HANDLE, $big_endian, | |
2981 "record length"); | |
2982 goto incomplete if (!defined($length)); | |
2983 # Convert length to bytes | |
2984 $length *= 4; | |
2985 # Calculate start of next record | |
2986 $next_pos = tell(HANDLE); | |
2987 goto tell_error if ($next_pos == -1); | |
2988 $next_pos += $length; | |
2989 # Process record | |
2990 if ($tag == $tag_function) { | |
2991 ($filename, $function) = read_gcno_function_record( | |
2992 *HANDLE, $bb, $fileorder, $base, $big_endian); | |
2993 goto incomplete if (!defined($function)); | |
2994 } elsif ($tag == $tag_lines) { | |
2995 # Read lines record | |
2996 $filename = read_gcno_lines_record(*HANDLE, | |
2997 $gcno_filename, $bb, $fileorder, | |
2998 $filename, $function, $base, | |
2999 $big_endian); | |
3000 goto incomplete if (!defined($filename)); | |
3001 } else { | |
3002 # Skip record contents | |
3003 graph_skip(*HANDLE, $length, "unhandled record") | |
3004 or goto incomplete; | |
3005 } | |
3006 # Ensure that we are at the start of the next record | |
3007 $curr_pos = tell(HANDLE); | |
3008 goto tell_error if ($curr_pos == -1); | |
3009 next if ($curr_pos == $next_pos); | |
3010 goto record_error if ($curr_pos > $next_pos); | |
3011 graph_skip(*HANDLE, $next_pos - $curr_pos, | |
3012 "unhandled record content") | |
3013 or goto incomplete; | |
3014 } | |
3015 close(HANDLE); | |
3016 ($instr, $graph) = graph_from_bb($bb, $fileorder, $gcno_filename); | |
3017 graph_cleanup($graph); | |
3018 | |
3019 return ($instr, $graph); | |
3020 | |
3021 open_error: | |
3022 graph_error($gcno_filename, "could not open file"); | |
3023 return undef; | |
3024 incomplete: | |
3025 graph_error($gcno_filename, "reached unexpected end of file"); | |
3026 return undef; | |
3027 magic_error: | |
3028 graph_error($gcno_filename, "found unrecognized gcno file magic"); | |
3029 return undef; | |
3030 tell_error: | |
3031 graph_error($gcno_filename, "could not determine file position"); | |
3032 return undef; | |
3033 record_error: | |
3034 graph_error($gcno_filename, "found unrecognized record format"); | |
3035 return undef; | |
3036 } | |
3037 | |
3038 sub debug($) | |
3039 { | |
3040 my ($msg) = @_; | |
3041 | |
3042 return if (!$debug); | |
3043 print(STDERR "DEBUG: $msg"); | |
3044 } | |
3045 | |
3046 # | |
3047 # get_gcov_capabilities | |
3048 # | |
3049 # Determine the list of available gcov options. | |
3050 # | |
3051 | |
3052 sub get_gcov_capabilities() | |
3053 { | |
3054 my $help = `$gcov_tool --help`; | |
3055 my %capabilities; | |
3056 | |
3057 foreach (split(/\n/, $help)) { | |
3058 next if (!/--(\S+)/); | |
3059 next if ($1 eq 'help'); | |
3060 next if ($1 eq 'version'); | |
3061 next if ($1 eq 'object-directory'); | |
3062 | |
3063 $capabilities{$1} = 1; | |
3064 debug("gcov has capability '$1'\n"); | |
3065 } | |
3066 | |
3067 return \%capabilities; | |
3068 } | |
OLD | NEW |