imcover.perl

   1 #!perl -w
   2 use strict;
   3 use Config;
   4 use ExtUtils::Manifest 'maniread';
   5 use Cwd;
   6
   7 my $make = $Config{make};
   8 # if there's a way to make with profiling for a recursive build like
   9 # Imager I don't see how
  10 if (-f 'Makefile') {
  11     system "$make clean";
  12 }
  13 system "cover -delete";
  14 system "perl Makefile.PL --coverage"
  15   and die;
  16 system "$make 'OTHERLDFLAGS=-ftest-coverage -fprofile-arcs'"
  17   and die;
  18
  19 {
  20   local $ENV{DEVEL_COVER_OPTIONS} = "-db," . getcwd() . "/cover_db";
  21   system "$make test TEST_VERBOSE=1 HARNESS_PERL_SWITCHES=-MDevel::Cover";
  22 }
  23
  24 # build gcov files
  25 my $mani = maniread();
  26 # split by directory
  27 my %paths;
  28 for my $filename (keys %$mani) {
  29   next unless $filename =~ /\.(xs|c|im)$/;
  30   if ($filename =~ m!^(\w+)/(\w+\.\w+)$!) {
  31     push @{$paths{$1}}, $2;
  32   }
  33   else {
  34     push @{$paths{''}}, $filename;
  35   }
  36 }
  37
  38 for my $path (keys %paths) {
  39   if ($path) {
  40     system "cd $path ; gcov @{$paths{$path}} ; cd ..";
  41   }
  42   else {
  43     system "gcov @{$paths{$path}}";
  44   }
  45   my $dir = $path ? $path : '.';
  46   for my $file (@{$paths{$path}}) {
  47     system "gcov2perl $dir/$file.gcov";
  48   }
  49 }
  50
  51 my @dbs = "cover_db", map "$_/cover_db", grep $_, keys %paths;
  52 system "cover -ignore_re '^t/'";
  53