Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 71 lines (63 sloc) 1.54 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
#!perl -w
use strict;
use Config;
use ExtUtils::Manifest 'maniread';
use Cwd;
use Getopt::Long;

my @tests;
my $verbose;
GetOptions("t|test=s" => \@tests,
"v" => \$verbose)
  or die;

my $make = $Config{make};
# if there's a way to make with profiling for a recursive build like
# Imager I don't see how
if (-f 'Makefile') {
  run("$make clean");
}
run("cover -delete");
run("perl Makefile.PL --coverage")
  and die;
run("$make 'OTHERLDFLAGS=-ftest-coverage -fprofile-arcs'")
  and die;

{
  local $ENV{DEVEL_COVER_OPTIONS} = "-db," . getcwd() . "/cover_db,-coverage,statement,branch,condition,subroutine";
  my $makecmd = "$make test TEST_VERBOSE=1 HARNESS_PERL_SWITCHES=-MDevel::Cover";
  if (@tests) {
    $makecmd .= " TEST_FILES='@tests'";
  }
  run($makecmd);
}

# build gcov files
my $mani = maniread();
# split by directory
my %paths;
for my $filename (keys %$mani) {
  next unless $filename =~ /\.(xs|c|im)$/;
  if ($filename =~ m!^(\w+)/(\w+\.\w+)$!) {
    push @{$paths{$1}}, $2;
  }
  else {
    push @{$paths{''}}, $filename;
  }
}

for my $path (keys %paths) {
  if ($path) {
    run("cd $path ; gcov -abc @{$paths{$path}} ; cd ..");
  }
  else {
    run("gcov -abc @{$paths{$path}}");
  }
  my $dir = $path ? $path : '.';
  for my $file (@{$paths{$path}}) {
    run("gcov2perl $dir/$file.gcov");
  }
}

my @dbs = "cover_db", map "$_/cover_db", grep $_, keys %paths;
# we already ran gcov
run("cover -nogcov -ignore_re '^t/'");

sub run {
  my $cmd = shift;

  print "Running: $cmd\n" if $verbose;
  return system $cmd;
}
Something went wrong with that request. Please try again.