Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add compilation report (Denis Howe).

  • Loading branch information...
commit ccb0d39f5a7f9ddb0e5aa61933079c3410665fed 1 parent 2fcd710
@pjcj authored
View
1  MANIFEST
@@ -23,6 +23,7 @@ lib/Devel/Cover/DB/File.pm
lib/Devel/Cover/DB/Structure.pm
lib/Devel/Cover/Op.pm
lib/Devel/Cover/Pod.pm
+lib/Devel/Cover/Report/Compilation.pm
lib/Devel/Cover/Report/Html.pm
lib/Devel/Cover/Report/Html_basic.pm
lib/Devel/Cover/Report/Html_minimal.pm
View
183 lib/Devel/Cover/Report/Compilation.pm
@@ -0,0 +1,183 @@
+# Copyright 2001-2006, Paul Johnson (pjcj@cpan.org)
+
+# This software is free. It is licensed under the same terms as Perl itself.
+
+# ############################################################################ #
+# 2006-09-14 Denis Howe
+# Cloned from 0.59 Text.pm and hacked to give a minimal output in a
+# format similar to that output by Perl itself so that it's easier to
+# step through the untested locations with Emacs compilation mode
+# Copyright assigned to Paul Johnson
+# ############################################################################ #
+
+# The latest version of this software should be available from my homepage:
+# http://www.pjcj.net
+
+package Devel::Cover::Report::Compilation;
+
+use strict;
+use warnings;
+
+our $VERSION = "0.59";
+
+use Devel::Cover::DB 0.59;
+
+# TODO - uncoverable code?
+
+sub print_statement
+{
+ my ($db, $file, $options) = @_;
+
+ my $statements = $db->cover->file($file)->statement or return;
+
+ for my $location ($statements->items)
+ {
+ my $l = $statements->location($location);
+ for my $statement (@$l)
+ {
+ next if $statement->covered;
+ print "Uncovered statement at $file line $location:\n";
+ }
+ }
+}
+
+sub print_branches
+{
+ my ($db, $file, $options) = @_;
+
+ my $branches = $db->cover->file($file)->branch or return;
+
+ for my $location (sort { $a <=> $b } $branches->items)
+ {
+ for my $b (@{$branches->location($location)})
+ {
+ next unless $b->error;
+
+ # One or both paths from this branch weren't reached.
+ # $b->covered(0) and (1) say whether the first and second
+ # paths were reached. If the branch condition text begins
+ # with "unless" then the meanings of 0 and 1 are swapped.
+ # The output is easier to understand if we strip off
+ # "unless" and say whether the remaining condition was
+ # true or false.
+
+ my $text = $b->text;
+ my ($t, $f) = map $b->covered($_),
+ $text =~ s/^(if|unless) // && $1 eq "unless" ? (1, 0) : (0, 1);
+ # TODO - uncoverable code?
+ print "Branch never ",
+ $t ? ($f ? "???" : "false") : ($f ? "true" : "reached"),
+ " at $file line $location: $text\n";
+ }
+ }
+}
+
+sub print_conditions
+{
+ my ($db, $file, $options) = @_;
+
+ my $conditions = $db->cover->file($file)->condition or return;
+
+ my $template = sub { "%-5s %3s %6s " . ( "%6s " x shift ) . " %s\n" };
+
+ my %r;
+ for my $location (sort { $a <=> $b } $conditions->items)
+ {
+ my %seen;
+ for my $c (@{$conditions->location($location)})
+ {
+ push @{$r{$c->type}}, [ $c, $seen{$c->type}++ ? "" : $location ];
+ }
+ }
+
+ my %seen;
+ for my $type (sort keys %r)
+ {
+ my $tpl;
+ for (@{$r{$type}})
+ {
+ my ($c, $location) = @$_;
+ next unless $c->error;
+ my @headers = @{$c->headers};
+ print "Uncovered condition (", join(", ",
+ map (!$c->covered($_) ? $headers[$_] : (), 0..$c->total-1)),
+ ") at $file line $location: ", $c->text, "\n";
+ }
+ }
+}
+
+sub print_subroutines
+{
+ my ($db, $file, $options) = @_;
+
+ my $subroutines = $db->cover->file($file)->subroutine or return;
+
+ for my $location ($subroutines->items)
+ {
+ my $l = $subroutines->location($location);
+ for my $sub (@$l)
+ {
+ next if $sub->covered;
+ print "Uncovered subroutine ", $sub->name,
+ " at $file line $location\n";
+ }
+ }
+}
+
+sub report
+{
+ my ($pkg, $db, $options) = @_;
+
+ for my $file (@{$options->{file}})
+ {
+ print_statement ($db, $file, $options) if $options->{show}{statement};
+ print_branches ($db, $file, $options) if $options->{show}{branch};
+ print_conditions ($db, $file, $options) if $options->{show}{condition};
+ print_subroutines($db, $file, $options) if $options->{show}{subroutine};
+ }
+}
+
+1
+
+__END__
+
+=head1 NAME
+
+Devel::Cover::Report::Compilation - Backend for reporting of coverage
+statistics in a format like Perl compilation
+
+=head1 SYNOPSIS
+
+ cover -report compilation
+
+=head1 DESCRIPTION
+
+This module provides a textual reporting mechanism for coverage data.
+It is designed to be called from the C<cover> program.
+
+It produces one report per line, in a format like Perl's own compilation error
+messages. This makes it easy to, e.g. use Emacs compilation mode to step
+through the reports.
+
+=head1 SEE ALSO
+
+ Devel::Cover
+
+=head1 BUGS
+
+Huh?
+
+=head1 VERSION
+
+Version 0.59 - 23rd August 2006
+
+=head1 LICENCE
+
+Copyright 2001-2006, Paul Johnson (pjcj@cpan.org)
+
+This software is free. It is licensed under the same terms as Perl itself.
+
+The latest version of this software should be available from my homepage:
+http://www.pjcj.net
+
+=cut
View
4 lib/Devel/Cover/Report/Text.pm
@@ -29,7 +29,7 @@ sub print_runs
}
}
-sub print_file
+sub print_statement
{
my ($db, $file, $options) = @_;
@@ -269,7 +269,7 @@ sub report
print_runs($db, $options);
for my $file (@{$options->{file}})
{
- print_file ($db, $file, $options);
+ print_statement ($db, $file, $options) if $options->{show}{statement};
print_branches ($db, $file, $options) if $options->{show}{branch};
print_conditions ($db, $file, $options) if $options->{show}{condition};
print_subroutines($db, $file, $options) if $options->{show}{subroutine};
Please sign in to comment.
Something went wrong with that request. Please try again.