OO API
[imager.git] / imcover.perl
CommitLineData
1ef586b1
TC
1#!perl -w
2use strict;
3use Config;
4use ExtUtils::Manifest 'maniread';
86c50c46 5use Cwd;
7fcc2ea8
TC
6use Getopt::Long;
7
8my @tests;
9my $verbose;
10GetOptions("t|test=s" => \@tests,
11 "v" => \$verbose)
12 or die;
1ef586b1
TC
13
14my $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
17if (-f 'Makefile') {
7fcc2ea8 18 run("$make clean");
1ef586b1 19}
7fcc2ea8
TC
20run("cover -delete");
21run("perl Makefile.PL --coverage")
1ef586b1 22 and die;
7fcc2ea8 23run("$make 'OTHERLDFLAGS=-ftest-coverage -fprofile-arcs'")
1ef586b1
TC
24 and die;
25
86c50c46
TC
26{
27 local $ENV{DEVEL_COVER_OPTIONS} = "-db," . getcwd() . "/cover_db";
7fcc2ea8
TC
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);
86c50c46 33}
1ef586b1
TC
34
35# build gcov files
36my $mani = maniread();
37# split by directory
38my %paths;
39for 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
49for my $path (keys %paths) {
50 if ($path) {
7fcc2ea8 51 run("cd $path ; gcov -abc @{$paths{$path}} ; cd ..");
1ef586b1
TC
52 }
53 else {
7fcc2ea8 54 run("gcov -abc @{$paths{$path}}");
1ef586b1
TC
55 }
56 my $dir = $path ? $path : '.';
57 for my $file (@{$paths{$path}}) {
7fcc2ea8 58 run("gcov2perl $dir/$file.gcov");
1ef586b1
TC
59 }
60}
61
62my @dbs = "cover_db", map "$_/cover_db", grep $_, keys %paths;
7fcc2ea8
TC
63# we already ran gcov
64run("cover -nogcov -ignore_re '^t/'");
1ef586b1 65
7fcc2ea8
TC
66sub run {
67 my $cmd = shift;
68
69 print "Running: $cmd\n" if $verbose;
70 return system $cmd;
71}