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