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