Browse files

Fix up pod coverage percentages.

 Do pod coverage properly in html_basic.
  • Loading branch information...
1 parent 5c0136a commit 03f97c5a8b0addd36f1ce19beae56286af2fc86d @pjcj committed May 2, 2005
Showing with 97 additions and 77 deletions.
  1. +10 −5 lib/Devel/Cover.pm
  2. +4 −4 lib/Devel/Cover/Pod.pm
  3. +38 −66 lib/Devel/Cover/Report/Html_basic.pm
  4. +45 −2 test_output/cover/pod.5.006001
View
15 lib/Devel/Cover.pm
@@ -438,10 +438,13 @@ sub get_location
($File, $Line) = ($1, $2) if $File =~ /^\(eval \d+\)\[(.*):(\d+)\]/;
$File = normalised_file($File);
- unless (exists $Run{vec}{$File})
+ if (!exists $Run{vec}{$File} && $Run{collected})
{
- @{$Run{vec}{$File}{$_}}{"vec", "size"} = ("", 0)
- for grep $_ ne "time", @{$Run{collected}};
+ my %vec;
+ @vec{@{$Run{collected}}} = ();
+ delete $vec{time};
+ $vec{subroutine}++ if exists $vec{pod};
+ @{$Run{vec}{$File}{$_}}{"vec", "size"} = ("", 0) for keys %vec;
}
}
@@ -593,7 +596,8 @@ sub report
get_cover($_) for B::begin_av()->isa("B::AV") ? B::begin_av()->ARRAY : ();
if (exists &B::check_av)
{
- get_cover($_) for B::check_av()->isa("B::AV") ? B::check_av()->ARRAY : ();
+ get_cover($_)
+ for B::check_av()->isa("B::AV") ? B::check_av()->ARRAY : ();
}
get_cover($_) for get_ends()->isa("B::AV") ? get_ends()->ARRAY : ();
get_cover($_) for @Cvs;
@@ -1023,7 +1027,8 @@ sub get_cover
else
{
$Structure->set_subroutine($Sub_name, $File, $Line);
- add_subroutine_cover($start) if $Coverage{subroutine};
+ add_subroutine_cover($start)
+ if $Coverage{subroutine} || $Coverage{pod}; # pod requires subs
}
}
View
8 lib/Devel/Cover/Pod.pm
@@ -45,10 +45,10 @@ sub calculate_summary
$s->{Total}{total}{covered}++;
}
- $s->{$file}{pod}{error} ||= $e;
- $s->{$file}{total}{error} ||= $e;
- $s->{Total}{pod}{error} ||= $e;
- $s->{Total}{total}{error} ||= $e;
+ $s->{$file}{pod}{error} += $e;
+ $s->{$file}{total}{error} += $e;
+ $s->{Total}{pod}{error} += $e;
+ $s->{Total}{total}{error} += $e;
}
1
View
104 lib/Devel/Cover/Report/Html_basic.pm
@@ -61,10 +61,10 @@ sub get_summary
return \%vals unless defined $c->{percentage};
$vals{pc} = sprintf "%4.1f", $c->{percentage};
+ my $cr = $criterion eq "pod" ? "subroutine" : $criterion;
return \%vals
- if $criterion !~ /^branch|condition|subroutine|pod$/ ||
- !exists $R{filenames}{$file};
- $vals{link} = "$R{filenames}{$file}--$criterion.html";
+ if $cr !~ /^branch|condition|subroutine$/ || !exists $R{filenames}{$file};
+ $vals{link} = "$R{filenames}{$file}--$cr.html";
\%vals
};
@@ -137,8 +137,8 @@ sub print_file
my $pc = $link && $c !~ /subroutine|pod/;
my $text = $o ? $pc ? $o->percentage : $o->covered : "";
my %criterion = ( text => $text, class => oclass($o, $c) );
- $criterion{link} =
- "$R{filenames}{$R{file}}--$c.html#$n-$count"
+ my $cr = $c eq "pod" ? "subroutine" : $c;
+ $criterion{link} = "$R{filenames}{$R{file}}--$cr.html#$n-$count"
if $link;
push @{$line{criteria}}, \%criterion;
$error ||= $o->error if $o;
@@ -254,18 +254,31 @@ sub print_subroutines
{
my $subroutines = $R{db}->cover->file($R{file})->subroutine;
return unless $subroutines;
+ my $s = $R{options}->{show}{subroutines};
+
+ my $pods;
+ $pods = $R{db}->cover->file($R{file})->pod if $R{options}->{show}{pod};
my $subs;
for my $line (sort { $a <=> $b } $subroutines->items)
{
+ my @p;
+ if ($pods)
+ {
+ my $l = $pods->location($line);
+ @p = @$l if $l;
+ }
for my $o (@{$subroutines->location($line)})
{
+ my $p = shift @p;
push @$subs,
{
- line => $line,
- count => $o->covered,
- name => $o->name,
- class => oclass($o, "subroutine"),
+ line => $line,
+ name => $o->name,
+ count => $s ? $o->covered : "",
+ class => $s ? oclass($o, "subroutine") : "",
+ pod => $p ? $p->covered ? "Yes" : "No" : "n/a",
+ pclass => $p ? oclass($p, "pod") : "",
};
}
}
@@ -281,36 +294,6 @@ sub print_subroutines
$Template->process("subroutines", $vars, $html) or die $Template->error();
}
-sub print_pods
-{
- my $pods = $R{db}->cover->file($R{file})->pod;
- return unless $pods;
-
- my $ps;
- for my $line (sort { $a <=> $b } $pods->items)
- {
- for my $o (@{$pods->location($line)})
- {
- push @$ps,
- {
- line => $line,
- name => $o->name,
- class => oclass($o, "pod"),
- };
- }
- }
-
- my $vars =
- {
- R => \%R,
- pods => $ps,
- };
-
- my $html =
- "$R{options}{outputdir}/$R{filenames}{$R{file}}--pod.html";
- $Template->process("pod", $vars, $html) or die $Template->error();
-}
-
sub report
{
my ($pkg, $db, $options) = @_;
@@ -354,11 +337,11 @@ sub report
for (@{$options->{file}})
{
$R{file} = $_;
+ my $show = $options->{show};
print_file;
- print_branches if $options->{show}{branch};
- print_conditions if $options->{show}{condition};
- print_subroutines if $options->{show}{subroutine};
- # print_pods if $options->{show}{pod};
+ print_branches if $show->{branch};
+ print_conditions if $show->{condition};
+ print_subroutines if $show->{subroutine} || $show->{pod};
}
}
@@ -602,13 +585,23 @@ $Templates{subroutines} = <<'EOT';
<table>
<tr>
<th> line </th>
- <th> count </th>
+ [% IF R.options.show.subroutine %]
+ <th> count </th>
+ [% END %]
+ [% IF R.options.show.pod %]
+ <th> pod </th>
+ [% END %]
<th> subroutine </th>
</tr>
[% FOREACH sub = subs %]
<tr>
<td class="h"> [% sub.line %] </td>
- <td class="[% sub.class %]"> [% sub.count %] </td>
+ [% IF R.options.show.subroutine %]
+ <td class="[% sub.class %]"> [% sub.count %] </td>
+ [% END %]
+ [% IF R.options.show.pod %]
+ <td class="[% sub.pclass %]"> [% sub.pod %] </td>
+ [% END %]
<td> [% sub.name %] </td>
</tr>
[% END %]
@@ -617,27 +610,6 @@ $Templates{subroutines} = <<'EOT';
[% END %]
EOT
-$Templates{pods} = <<'EOT';
-[% WRAPPER html %]
-
-<h1> Pod Coverage </h1>
-
-<table>
- <tr>
- <th> line </th>
- <th> subroutine </th>
- </tr>
- [% FOREACH pod = pods %]
- <tr>
- <td class="h"> [% pod.line %] </td>
- <td class="[% pod.class %]"> [% pod.name %] </td>
- </tr>
- [% END %]
-</table>
-
-[% END %]
-EOT
-
# remove some whitespace from templates
s/^\s+//gm for values %Templates;
View
47 test_output/cover/pod.5.006001
@@ -4,8 +4,9 @@ Reading database from /home/pjcj/g/perl/Devel-Cover/cover_db
--------------------------------------------------------------- ------ ------
File pod total
--------------------------------------------------------------- ------ ------
-tests/Module1.pm 66.7 66.7
-Total 66.7 66.7
+tests/Module1.pm 33.3 33.3
+tests/pod n/a n/a
+Total 33.3 33.3
--------------------------------------------------------------- ------ ------
@@ -59,3 +60,45 @@ line err pod code
39 __END__
+tests/pod
+
+line err pod code
+1 #!/usr/bin/perl
+2
+3 # Copyright 2002-2005, Paul Johnson (pjcj@cpan.org)
+4
+5 # This software is free. It is licensed under the same terms as Perl itself.
+6
+7 # The latest version of this software should be available from my homepage:
+8 # http://www.pjcj.net
+9
+10 # __COVER__ criteria pod-also_private-xx
+11
+12 use strict;
+13 use warnings;
+14
+15 use lib "tests";
+16
+17 use Module1;
+18
+19 my @x;
+20
+21 sub xx
+22 {
+23 $x[shift]++;
+24 Module1::zz(0);
+25 }
+26
+27 for (0 .. 10)
+28 {
+29 if (time)
+30 {
+31 xx(0);
+32 }
+33 else
+34 {
+35 $x[1]++;
+36 }
+37 }
+
+

0 comments on commit 03f97c5

Please sign in to comment.