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         12 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         15 require 5.6.1;
14              
15 1     1   27 use strict;
  1         11  
  1         15  
16 1     1   15 use warnings;
  1         8  
  1         14  
17              
18 1         10 our $VERSION = "0.61";
19              
20 1     1   14 use Devel::Cover::DB 0.61;
  1         20  
  1         16  
21              
22 1     1   14 use File::Path;
  1         9  
  1         21  
23 1     1   26 use Getopt::Long;
  1         9  
  1         16  
24 1     1   36 use Pod::Usage;
  1         11  
  1         40  
25              
26 1         155 my $Options =
27             {
28                 db => "cover_db",
29                 merge => 1,
30             };
31              
32             sub get_options
33             {
34 1 50   1   15     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     2410     print "$0 version $VERSION\n" and exit 0 if $Options->{version};
44 1 50       15     pod2usage(-exitval => 0, -verbose => 0) if $Options->{help};
45 1 50       14     pod2usage(-exitval => 0, -verbose => 2) if $Options->{info};
46             }
47              
48             sub add_cover
49             {
50 26     26   1261     my ($file) = @_;
51              
52 26         236     my $f = $file;
53 26         383     $f =~ s/.gcov$//;
54              
55 26         212     my %run;
56 26         391     $run{collected} = ["statement"];
57 26         535     my $structure = Devel::Cover::DB::Structure->new;
58 26         2485     $structure->add_criteria("statement");
59 26         813     $run{digests}{$f} = $structure->set_file($f);
60              
61 26 50       19001     open F, $file or die "Can't open $file: $!\n";
62 26         22698     while (<F>)
63                 {
64 3802 50       93042         next unless my ($count, $line) = /(.{9}):\s*(\d+):/;
65 3802         54632         $count =~ s/\s+//g;
66 3802 100       57449         next if $count eq "-";
67 572 100       5599         $count = 0 if $count eq "#####";
68              
69             # print "$f:$line - $count\n";
70 572         5037         push @{$run{count}{$f}{statement}}, $count;
  572         18258  
71 572         9181         $structure->add_statement($f, $line);
72                 }
73 26 50       668     close F or die "Can't close $file: $!\n";
74              
75 26         815     my $run = time . ".$$." . sprintf "%05d", rand 2 ** 16;
76 26         289     my $db = $Options->{db};
77 26         2040     my $cover = Devel::Cover::DB->new
78                 (
79                     base => $db,
80                     runs => { $run => \%run },
81                     structure => $structure,
82                 );
83              
84 26         2146     $db .= "/runs";
85 26 50       637     mkpath $db unless -d $db;
86 26         233     $db .= "/$run";
87              
88 26         259     $cover->{db} = $db;
89              
90 26         15226     print STDOUT "gcov2perl: Writing coverage database to $db\n";
91 26         2393     $cover->write;
92             }
93              
94             sub main
95             {
96 1     1   11     get_options;
97 1         8     add_cover $_ for @ARGV;
  1         14  
98             }
99              
100 1         12 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