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
52use strict;
53use File::Basename; 
54use File::Spec::Functions qw /abs2rel catdir file_name_is_absolute splitdir
55			      splitpath/;
56use Getopt::Long;
57use Digest::MD5 qw(md5_base64);
58
59
60# Constants
61our $lcov_version	= 'LCOV version 1.9';
62our $lcov_url		= "http://ltp.sourceforge.net/coverage/lcov.php";
63our $gcov_tool		= "gcov";
64our $tool_name		= basename($0);
65
66our $GCOV_VERSION_3_4_0	= 0x30400;
67our $GCOV_VERSION_3_3_0	= 0x30300;
68our $GCNO_FUNCTION_TAG	= 0x01000000;
69our $GCNO_LINES_TAG	= 0x01450000;
70our $GCNO_FILE_MAGIC	= 0x67636e6f;
71our $BBG_FILE_MAGIC	= 0x67626267;
72
73our $COMPAT_HAMMER	= "hammer";
74
75our $ERROR_GCOV		= 0;
76our $ERROR_SOURCE	= 1;
77our $ERROR_GRAPH	= 2;
78
79our $EXCL_START = "LCOV_EXCL_START";
80our $EXCL_STOP = "LCOV_EXCL_STOP";
81our $EXCL_LINE = "LCOV_EXCL_LINE";
82
83our $BR_LINE		= 0;
84our $BR_BLOCK		= 1;
85our $BR_BRANCH		= 2;
86our $BR_TAKEN		= 3;
87our $BR_VEC_ENTRIES	= 4;
88our $BR_VEC_WIDTH	= 32;
89
90our $UNNAMED_BLOCK	= 9999;
91
92# Prototypes
93sub print_usage(*);
94sub gen_info($);
95sub process_dafile($$);
96sub match_filename($@);
97sub solve_ambiguous_match($$$);
98sub split_filename($);
99sub solve_relative_path($$);
100sub read_gcov_header($);
101sub read_gcov_file($);
102sub info(@);
103sub get_gcov_version();
104sub system_no_output($@);
105sub read_config($);
106sub apply_config($);
107sub get_exclusion_data($);
108sub apply_exclusion_data($$);
109sub process_graphfile($$);
110sub filter_fn_name($);
111sub warn_handler($);
112sub die_handler($);
113sub graph_error($$);
114sub graph_expect($);
115sub graph_read(*$;$);
116sub graph_skip(*$;$);
117sub sort_uniq(@);
118sub sort_uniq_lex(@);
119sub graph_cleanup($);
120sub graph_find_base($);
121sub graph_from_bb($$$);
122sub graph_add_order($$$);
123sub read_bb_word(*;$);
124sub read_bb_value(*;$);
125sub read_bb_string(*$);
126sub read_bb($$);
127sub read_bbg_word(*;$);
128sub read_bbg_value(*;$);
129sub read_bbg_string(*);
130sub read_bbg_lines_record(*$$$$$$);
131sub read_bbg($$);
132sub read_gcno_word(*;$);
133sub read_gcno_value(*$;$);
134sub read_gcno_string(*$);
135sub read_gcno_lines_record(*$$$$$$$);
136sub read_gcno_function_record(*$$$$);
137sub read_gcno($$);
138sub get_gcov_capabilities();
139sub get_overall_line($$$$);
140sub print_overall_rate($$$$$$$$$);
141sub br_gvec_len($);
142sub br_gvec_get($$);
143sub debug($);
144sub int_handler();
145
146
147# Global variables
148our $gcov_version;
149our $graph_file_extension;
150our $data_file_extension;
151our @data_directory;
152our $test_name = "";
153our $quiet;
154our $help;
155our $output_filename;
156our $base_directory;
157our $version;
158our $follow;
159our $checksum;
160our $no_checksum;
161our $compat_libtool;
162our $no_compat_libtool;
163our $adjust_testname;
164our $config;		# Configuration file contents
165our $compatibility;	# Compatibility version flag - used to indicate
166			# non-standard GCOV data format versions
167our @ignore_errors;	# List of errors to ignore (parameter)
168our @ignore;		# List of errors to ignore (array)
169our $initial;
170our $no_recursion = 0;
171our $maxdepth;
172our $no_markers = 0;
173our $opt_derive_func_data = 0;
174our $debug = 0;
175our $gcov_caps;
176our @gcov_options;
177
178our $cwd = `pwd`;
179chomp($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
198if (defined($ENV{"HOME"}) && (-r $ENV{"HOME"}."/.lcovrc"))
199{
200	$config = read_config($ENV{"HOME"}."/.lcovrc");
201}
202elsif (-r "/etc/lcovrc")
203{
204	$config = read_config("/etc/lcovrc");
205}
206
207if ($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
226if (!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}
249else
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
268if ($help)
269{
270	print_usage(*STDOUT);
271	exit(0);
272}
273
274# Check for version option
275if ($version)
276{
277	print("$tool_name: $lcov_version\n");
278	exit(0);
279}
280
281# Make sure test names only contain valid characters
282if ($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
288if ($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
295if ($base_directory)
296{
297	$base_directory = solve_relative_path($cwd, $base_directory);
298}
299
300# Check for follow option
301if ($follow)
302{
303	$follow = "-follow"
304}
305else
306{
307	$follow = "";
308}
309
310# Determine checksum mode
311if (defined($checksum))
312{
313	# Normalize to boolean
314	$checksum = ($checksum ? 1 : 0);
315}
316else
317{
318	# Default is off
319	$checksum = 0;
320}
321
322# Determine libtool compatibility mode
323if (defined($compat_libtool))
324{
325	$compat_libtool = ($compat_libtool? 1 : 0);
326}
327else
328{
329	# Default is on
330	$compat_libtool = 1;
331}
332
333# Determine max depth for recursion
334if ($no_recursion)
335{
336	$maxdepth = "-maxdepth 1";
337}
338else
339{
340	$maxdepth = "";
341}
342
343# Check for directory name
344if (!@data_directory)
345{
346	die("No directory specified\n".
347	    "Use $tool_name --help to get usage information\n");
348}
349else
350{
351	foreach (@data_directory)
352	{
353		stat($_);
354		if (!-r _)
355		{
356			die("ERROR: cannot read $_!\n");
357		}
358	}
359}
360
361if (@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
387if (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
394if ($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}
407else
408{
409	$data_file_extension = ".gcda";
410	$graph_file_extension = ".gcno";
411}	
412
413# Determine gcov options
414$gcov_caps = get_gcov_capabilities();
415push(@gcov_options, "-b") if ($gcov_caps->{'branch-probabilities'});
416push(@gcov_options, "-c") if ($gcov_caps->{'branch-counts'});
417push(@gcov_options, "-a") if ($gcov_caps->{'all-blocks'});
418push(@gcov_options, "-p") if ($gcov_caps->{'preserve-paths'});
419
420# Check output filename
421if (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
439foreach my $entry (@data_directory) {
440	gen_info($entry);
441}
442
443if ($initial) {
444	warn("Note: --initial does not generate branch coverage ".
445	     "data\n");
446}
447info("Finished .info-file creation\n");
448
449exit(0);
450
451
452
453#
454# print_usage(handle)
455#
456# Print usage information.
457#
458
459sub print_usage(*)
460{
461	local *HANDLE = $_[0];
462
463	print(HANDLE <<END_OF_USAGE);
464Usage: $tool_name [OPTIONS] DIRECTORY
465
466Traverse DIRECTORY and create a .info file for each data file found. Note
467that you may specify more than one directory, all of which are then processed
468sequentially.
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
487For more information see: $lcov_url
488END_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
500sub 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
560sub 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
607sub 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
682sub 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
707sub 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
1167sub 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
1205sub 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
1214entry:
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
1254sub 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
1306sub 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
1333sub 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
1384sub 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
1399sub 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
1431sub 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
1478sub 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
1665sub 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
1707sub 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
1731sub 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
1751sub 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
1788sub 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
1839sub 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
1861sub 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
1908sub 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
2004sub 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
2135sub 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
2145sub warn_handler($)
2146{
2147	my ($msg) = @_;
2148
2149	warn("$tool_name: $msg");
2150}
2151
2152sub 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
2167sub 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
2185sub 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
2203sub 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
2244sub 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
2260sub 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
2277sub 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
2295sub 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
2329sub 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
2391sub 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
2442sub 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
2463sub 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
2477sub 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
2495sub 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
2532sub 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
2582open_error:
2583	graph_error($bb_filename, "could not open file");
2584	return undef;
2585incomplete:
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
2596sub 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
2609sub 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
2626sub 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
2656sub 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
2706sub 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
2769open_error:
2770	graph_error($bbg_filename, "could not open file");
2771	return undef;
2772incomplete:
2773	graph_error($bbg_filename, "reached unexpected end of file");
2774	return undef;
2775magic_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
2786sub 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
2800sub 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
2820sub 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
2850sub 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
2895sub 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
2939sub 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
3021open_error:
3022	graph_error($gcno_filename, "could not open file");
3023	return undef;
3024incomplete:
3025	graph_error($gcno_filename, "reached unexpected end of file");
3026	return undef;
3027magic_error:
3028	graph_error($gcno_filename, "found unrecognized gcno file magic");
3029	return undef;
3030tell_error:
3031	graph_error($gcno_filename, "could not determine file position");
3032	return undef;
3033record_error:
3034	graph_error($gcno_filename, "found unrecognized record format");
3035	return undef;
3036}
3037
3038sub 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
3052sub 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}
3069