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("$^X 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 my $gcov2perl = $Config{sitebin} . "/gcov2perl";
  72
  73 for my $path (keys %paths) {
  74   if ($path) {
  75     run("cd $path ; gcov -abc @{$paths{$path}} ; cd ..");
  76   }
  77   else {
  78     run("gcov -abc @{$paths{$path}}");
  79   }
  80   my $dir = $path ? $path : '.';
  81   for my $file (@{$paths{$path}}) {
  82     run("$gcov2perl $dir/$file.gcov");
  83   }
  84 }
  85
  86 my @dbs = "cover_db", map "$_/cover_db", grep $_, keys %paths;
  87 # we already ran gcov
  88 run("cover -nogcov -ignore_re '^t/'");
  89
  90 sub run {
  91   my $cmd = shift;
  92
  93   print "Running: $cmd\n" if $verbose;
  94   return system $cmd;
  95 }
  96
  97 =head1 NAME
  98
  99 imcover.perl - perform C and perl coverage testing for Imager
 100
 101 =head1 SYNOPSIS
 102
 103   perl imcover.perl [-m=...][-t=...][-n][-v][-r] -- ... Makefile.PL options
 104
 105 =head1 DESCRIPTION
 106
 107 Builds Imager with the C< -ftest-coverage -fprofile-arcs > gcc options
 108 and then runs perl's tests.
 109
 110 =cut