path: root/third_party/lcov/bin/mcov

#!/usr/bin/perl -w
# 
# mcov: script to convert gcov data to lcov format on Mac.
#
# Based on lcov (http://ltp.sourceforge.net/coverage/lcov.php)
# Written by ajeya at google dot com.
#
# usage:
# mcov --directory <base directory> --output <output file> --verbose <level>
#
 
use strict;

use Cwd;
use File::Basename;
use File::Find;
use File::Spec::Functions;
use Getopt::Long;

# function prototypes
sub process_dafile(@);
sub canonical_path(@);
sub split_filename(@);
sub read_gcov_header(@);
sub read_gcov_file(@);

# scalars with default values
my $directory = Cwd::abs_path(Cwd::getcwd);
my $data_file_extension = ".gcda";
my $output_filename = "output.lcov";
my $gcov_tool  = "/usr/bin/gcov";
my $verbosity = 0;

# TODO(ajeya): GetOptions doesn't handle case where the script is called with
# no arguments. This needs to be fixed.
my $result = GetOptions("directory|d=s" => \$directory,
                         "output|o=s" => \$output_filename,
                         "verbose" => \$verbosity);                        
if (!$result) {
  print "Usage: $0  --directory <base directory> --output <output file>";
  print " [--verbose <level>]\n";
  exit(1);
}

# convert the directory path to absolute path.
$directory = Cwd::abs_path($directory);

# convert the output file path to absolute path.
$output_filename = Cwd::abs_path($output_filename);

# Output expected args for buildbot debugging assistance.
my $cwd = getcwd();
print "mcov: after abs_pathing\n";
print "mcov: getcwd() = $cwd\n";
print "mcov: directory for data files is $directory\n";
print "mcov: output filename is $output_filename\n";

# Sanity check; die if path is wrong.
# We don't check for output_filename because... we create it.
if (! -d $directory) {
  print "mcov: Bad args passed; exiting with error.\n";
  exit(1);
}

# open file for output
open(INFO_HANDLE, ">$output_filename");

my @file_list;  # scalar to hold the list of all gcda files.
if (-d $directory) {
  printf("Scanning $directory for $data_file_extension files ...\n");
  find(sub {
         my $file = $_;
         if ($file =~ m/\Q$data_file_extension\E$/i) {
           push(@file_list, Cwd::abs_path($file));
         }},
       $directory);
  printf("Found %d data files in %s\n", $#file_list + 1, $directory);
}

# Process all files in list
foreach my $file (@file_list) {
  process_dafile($file);
}
close(INFO_HANDLE);

# Remove the misc gcov files that are created.
my @gcov_list = glob("*.gcov");
foreach my $gcov_file (@gcov_list) {
  unlink($gcov_file);
}

exit(0);

# end of script

# process_dafile:
# argument(s): a file path with gcda extension
# returns: void 
# This method calls gcov to generate the coverage data and write the output in
# lcov format to the output file.
sub process_dafile(@) {
  my ($filename) = @_;
  print("Processing $filename ...\n");

  my $da_filename;   # Name of data file to process
  my $base_name;     # data filename without ".da/.gcda" extension
  my $gcov_error;    # Error code of gcov tool
  my $object_dir;    # Directory containing all object files
  my $gcov_file;     # Name of a .gcov file
  my @gcov_data;     # Contents of a .gcov file
  my @gcov_list;     # List of generated .gcov files
  my $base_dir;      # Base directory for current da file
  local *OLD_STDOUT; # Handle to store STDOUT temporarily
  
  # Get directory and basename of data file
  ($base_dir, $base_name) = split_filename(canonical_path($filename));

  # Check for writable $base_dir (gcov will try to write files there)
  if (!-w $base_dir) {
    print("ERROR: cannot write to directory $base_dir\n");
    return;
  }

  # Construct name of graph file
  $da_filename = File::Spec::Functions::catfile($base_dir,
                                                join(".", $base_name, "gcno"));

  # Ignore empty graph file (e.g. source file with no statement)
  if (-z $da_filename) {
    warn("WARNING: empty $da_filename (skipped)\n");
    return;
  }
    
  # Set $object_dir to real location of object files. This may differ
  # from $base_dir if the graph file is just a link to the "real" object
  # file location.
  $object_dir = dirname($da_filename);
  
  # Save the current STDOUT to OLD_STDOUT and set STDOUT to /dev/null to mute
  # standard output.
  if (!$verbosity) {
    open(OLD_STDOUT, ">>&STDOUT");
    open(STDOUT, ">/dev/null");
  }
  
  # run gcov utility with the supplied gcno file and object directory.
  $gcov_error = system($gcov_tool, $da_filename, "-o", $object_dir);
  
  # Restore STDOUT if we changed it before.
  if (!$verbosity) {
    open(STDOUT, ">>&OLD_STDOUT");
  }

  if ($gcov_error) {
    warn("WARNING: GCOV failed for $da_filename!\n");
    return;
  }

  # Collect data from resulting .gcov files and create .info file
  @gcov_list = glob("*.gcov");
  # Check for files
  if (!scalar(@gcov_list)) {
    warn("WARNING: gcov did not create any files for $da_filename!\n");
  }
  
  foreach $gcov_file (@gcov_list) {
    my $source_filename = read_gcov_header($gcov_file);
    
    if (!defined($source_filename)) {
      next;
    }
    
    $source_filename = canonical_path($source_filename);
    
    # Read in contents of gcov file
    @gcov_data = read_gcov_file($gcov_file);
    
    # Skip empty files
    if (!scalar(@gcov_data)) {
      warn("WARNING: skipping empty file $gcov_file\n");
      unlink($gcov_file);
      next;
    }
        
    print(INFO_HANDLE "SF:", Cwd::abs_path($source_filename), "\n");

    # Write coverage information for each instrumented line
    # Note: @gcov_content contains a list of (flag, count, source)
    # tuple for each source code line
    while (@gcov_data) {
      # Check for instrumented line 
      if ($gcov_data[0]) {
        print(INFO_HANDLE "DA:", $gcov_data[3], ",", $gcov_data[1], "\n");
      }
      # Remove already processed data from array
      splice(@gcov_data,0,4);  
    }
    print(INFO_HANDLE "end_of_record\n");
    
    # Remove .gcov file after processing
    unlink($gcov_file);
  } #end for_each
}

# canonical_path:
# argument(s): any file path
# returns: the file path as a string
# 
# clean up the file path being passed.
sub canonical_path(@) {
  my ($filename) = @_;
  return (File::Spec::Functions::canonpath($filename));
}

# split_filename:
# argument(s): any file path
# returns: an array with the path components
# 
# splits the file path into path and filename (with no extension).
sub split_filename(@){
  my ($filename) = @_;
  my ($base, $path, $ext) = File::Basename::fileparse($filename, '\.[^\.]*');
  return ($path, $base);
}

# read_gcov_header:
# argument(s): path to gcov file
# returns: an array the contens of the gcov header.
# 
# reads the gcov file and returns the parsed contents of a gcov header as an 
# array.
sub read_gcov_header(@) {
  my ($filename) = @_;
  my $source;
  local *INPUT;

  if (!open(INPUT, $filename)) {
    warn("WARNING: cannot read $filename!\n");
    return (undef,undef);
  }
  
  my @lines = <INPUT>;
  foreach my $line (@lines) {
    chomp($line);
    # check for lines with source string. 
    if ($line =~ /^\s+-:\s+0:Source:(.*)$/) {
      # Source: header entry
      $source = $1;
    } else {
      last;
    }
  }
  close(INPUT);
  return $source;
}

# read_gcov_file:
# argument(s): path to gcov file
# returns: an array with the contents of the gcov file.
# 
# reads the gcov file and returns the parsed contents of a gcov file
# as an array.
sub read_gcov_file(@) {
  my ($filename) = @_;
  my @result = ();
  my $number;
  local *INPUT;

  if (!open(INPUT, $filename)) {
    warn("WARNING: cannot read $filename!\n");
    return @result;
  }
  
  # Parse gcov output and populate the array
  my @lines = <INPUT>;
  foreach my $line (@lines) {
    chomp($line);
    if ($line =~ /^\s*([^:]+):\s*(\d+?):(.*)$/) {
      # <exec count>:<line number>:<source code>
      
      if ($1 eq "-") {
        # Uninstrumented line
        push(@result, 0);
        push(@result, 0);
        push(@result, $3);
        push(@result, $2);
      } elsif ($2 eq "0") {
        #ignore comments and other header info
      } else {
        # Source code execution data
        $number = $1;
        # Check for zero count
        if ($number eq "#####") {
          $number = 0;
        }
        push(@result, 1);
        push(@result, $number);
        push(@result, $3);
        push(@result, $2);
      }  
    }
  }
  close(INPUT);
  return @result;
}