File Coverage

/usr/local/pkg/cover/20070318/sw/bin/gcov2perl
Criterion Covered Total %
statement 57 57 100.0
branch 12 20 60.0
condition 0 3 0.0
subroutine 9 9 100.0
pod n/a
total 78 89 87.6


line stmt bran cond sub pod time code
1             #!/usr/local/pkg/cover/20070318/sw/bin/perl
2              
3 1         11 eval 'exec /usr/local/pkg/cover/20070318/sw/bin/perl -S $0 ${1+"$@"}'
4                 if 0; # not running under some shell
5              
6             # Copyright 2001-2007, Paul Johnson (pjcj@cpan.org)
7              
8             # This software is free. It is licensed under the same terms as Perl itself.
9              
10             # The latest version of this software should be available from my homepage:
11             # http://www.pjcj.net
12              
13 1         16 require 5.6.1;
14              
15 1     1   30 use strict;
  1         11  
  1         16  
16 1     1   16 use warnings;
  1         9  
  1         15  
17              
18 1         10 our $VERSION = "0.61";
19              
20 1     1   15 use Devel::Cover::DB 0.61;
  1         22  
  1         15  
21              
22 1     1   14 use File::Path;
  1         9  
  1         21  
23 1     1   26 use Getopt::Long;
  1         10  
  1         16  
24 1     1   27 use Pod::Usage;
  1         10  
  1         39  
25              
26 1         14 my $Options =
27             {
28                 db => "cover_db",
29                 merge => 1,
30             };
31              
32             sub get_options
33             {
34 1 50   1   194     die "Bad option" unless
35                 GetOptions($Options, # Store the options in the Options hash.
36                            qw(
37             db=s
38             help|h!
39             info|i!
40             merge!
41             version|v!
42             ));
43 1 50 0     1596     print "$0 version $VERSION\n" and exit 0 if $Options->{version};
44 1 50       40     pod2usage(-exitval => 0, -verbose => 0) if $Options->{help};
45 1 50       18     pod2usage(-exitval => 0, -verbose => 2) if $Options->{info};
46             }
47              
48             sub add_cover
49             {
50 1     1   13     my ($file) = @_;
51              
52 1         10     my $f = $file;
53 1         15     $f =~ s/.gcov$//;
54              
55 1         10     my %run;
56 1         13     $run{collected} = ["statement"];
57 1         75     my $structure = Devel::Cover::DB::Structure->new;
58 1         44     $structure->add_criteria("statement");
59 1         67     $run{digests}{$f} = $structure->set_file($f);
60              
61 1 50       407     open F, $file or die "Can't open $file: $!\n";
62 1         97     while (<F>)
63                 {
64 95 50       1880         next unless my ($count, $line) = /(.{9}):\s*(\d+):/;
65 95         1025         $count =~ s/\s+//g;
66 95 100       1142         next if $count eq "-";
67 21 100       189         $count = 0 if $count eq "#####";
68              
69             # print "$f:$line - $count\n";
70 21         164         push @{$run{count}{$f}{statement}}, $count;
  21         216  
71 21         889         $structure->add_statement($f, $line);
72                 }
73 1 50       29     close F or die "Can't close $file: $!\n";
74              
75 1         114     my $run = time . ".$$." . sprintf "%05d", rand 2 ** 16;
76 1         12     my $db = $Options->{db};
77 1         29     my $cover = Devel::Cover::DB->new
78                 (
79                     base => $db,
80                     runs => { $run => \%run },
81                     structure => $structure,
82                 );
83              
84 1         87     $db .= "/runs";
85 1 50       28     mkpath $db unless -d $db;
86 1         12     $db .= "/$run";
87              
88 1         12     $cover->{db} = $db;
89              
90 1         569     print STDOUT "gcov2perl: Writing coverage database to $db\n";
91 1         19     $cover->write;
92             }
93              
94             sub main
95             {
96 1     1   11     get_options;
97 1         9     add_cover $_ for @ARGV;
  1         16  
98             }
99              
100 1         10 main
101              
102             __END__
103            
104             =head1 NAME
105            
106             gcov2perl - convert gcov files to Devel::Cover databases
107            
108             =head1 SYNOPSIS
109            
110             gcov2perl -h -i -v -db database gcov_files
111            
112             =head1 DESCRIPTION
113            
114             Convert gcov files to Devel::Cover databases.
115            
116             =head1 OPTIONS
117            
118             The following command line options are supported:
119            
120             -db database - specify the database to use
121            
122             -h -help - show help
123             -i -info - show documentation
124             -v -version - show version
125            
126             =head1 DETAILS
127            
128             To obtain coverage of XS files they must first be compiled with the appropriare
129             options. In a standard Makefile environment, such as that created by
130             ExtUtils::MakeMaker, this can be accomplished with the command:
131            
132             HARNESS_PERL_SWITCHES=-MDevel::Cover make test \
133             CCFLAGS=-O0\ -fprofile-arcs\ -ftest-coverage \
134             OTHERLDFLAGS=-fprofile-arcs\ -ftest-coverage
135            
136             If you have already built your object files it may be necessary to run make
137             clean first, or to find some other way to ensure that they get rebuilt with the
138             options gcov requires.
139            
140             Now the code coverage data has been collected C<gcov> needs to be run:
141            
142             gcov Mylib.xs
143            
144             This will create one or more gcov files on which you can run C<gcov2perl>:
145            
146             gcov2perl Mylib.xs.gcov
147            
148             Finally, C<cover> should be run as usual with any options required:
149            
150             cover
151            
152             If you are running everything with standard options, you can do all this with
153             one command:
154            
155             cover -test
156            
157             =head1 EXIT STATUS
158            
159             The following exit values are returned:
160            
161             0 All files converted successfully
162             >0 An error occurred.
163            
164             =head1 SEE ALSO
165            
166             Devel::Cover
167            
168             =head1 BUGS
169            
170             Huh?
171            
172             =head1 VERSION
173            
174             Version 0.61 - 10th January 2007
175            
176             =head1 LICENCE
177            
178             Copyright 2001-2007, Paul Johnson (pjcj@cpan.org)
179            
180             This software is free. It is licensed under the same terms as Perl itself.
181            
182             The latest version of this software should be available from my homepage:
183             http://www.pjcj.net
184            
185             =cut
186