imcover.perl

   1 #!perl -w
   2 use strict;
   3 use Config;
   4 use ExtUtils::Manifest 'maniread';
   5 use Cwd;
   6 use Getopt::Long;
   7
   8 my @tests;
   9 my $verbose;
  10 GetOptions("t|test=s" => \@tests,
  11            "v" => \$verbose)
  12   or die;
  13
  14 my $make = $Config{make};
  15 # if there's a way to make with profiling for a recursive build like
  16 # Imager I don't see how
  17 if (-f 'Makefile') {
  18   run("$make clean");
  19 }
  20 run("cover -delete");
  21 run("perl Makefile.PL --coverage")
  22   and die;
  23 run("$make 'OTHERLDFLAGS=-ftest-coverage -fprofile-arcs'")
  24   and die;
  25
  26 {
  27   local $ENV{DEVEL_COVER_OPTIONS} = "-db," . getcwd() . "/cover_db,-coverage,statement,branch,condition,subroutine";
  28   my $makecmd = "$make test TEST_VERBOSE=1 HARNESS_PERL_SWITCHES=-MDevel::Cover";
  29   if (@tests) {
  30     $makecmd .= " TEST_FILES='@tests'";
  31   }
  32   run($makecmd);
  33 }
  34
  35 # build gcov files
  36 my $mani = maniread();
  37 # split by directory
  38 my %paths;
  39 for my $filename (keys %$mani) {
  40   next unless $filename =~ /\.(xs|c|im)$/;
  41   if ($filename =~ m!^(\w+)/(\w+\.\w+)$!) {
  42     push @{$paths{$1}}, $2;
  43   }
  44   else {
  45     push @{$paths{''}}, $filename;
  46   }
  47 }
  48
  49 for my $path (keys %paths) {
  50   if ($path) {
  51     run("cd $path ; gcov -abc @{$paths{$path}} ; cd ..");
  52   }
  53   else {
  54     run("gcov -abc @{$paths{$path}}");
  55   }
  56   my $dir = $path ? $path : '.';
  57   for my $file (@{$paths{$path}}) {
  58     run("gcov2perl $dir/$file.gcov");
  59   }
  60 }
  61
  62 my @dbs = "cover_db", map "$_/cover_db", grep $_, keys %paths;
  63 # we already ran gcov
  64 run("cover -nogcov -ignore_re '^t/'");
  65
  66 sub run {
  67   my $cmd = shift;
  68
  69   print "Running: $cmd\n" if $verbose;
  70   return system $cmd;
  71 }