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