Permalink
Browse files

import Devel::Cover 0.06

  • Loading branch information...
1 parent 310cdad commit 2202197223419815a39319011d462a2b2911fe91 @pjcj committed Nov 3, 2004
Showing with 304 additions and 87 deletions.
  1. +8 −1 CHANGES
  2. +45 −28 Cover.pm
  3. +124 −10 Cover/{Process.pm → DB.pm}
  4. +1 −1 Cover/Op.pm
  5. +3 −1 MANIFEST
  6. +2 −2 Makefile.PL
  7. +2 −0 TODO
  8. +60 −0 t/Compare.pm
  9. +4 −44 t/t1.t
  10. +55 −0 t/t2.t
View
@@ -15,6 +15,13 @@ Release 0.04 - 12th April 2001
- Include Devel::Cover::Op
- Add condition coverage (sort of).
-Release 0.05 -
+Release 0.05 - 9th August 2001
- Make line numbers more accurate when nextstate has been optimised away.
- Get things working with ithreads.
+
+Release 0.06 - 10th August 2001
+ - Rename Devel::Cover::Process to Devel::Cover::DB
+ - Make the database a directory.
+ - Add fix for eval in filename. (Arthur Bergman <arthur@contiller.se>)
+ - Add more tests and abstract away comparison subroutine.
+ - Clear @Inc if it is set explicitly.
View
@@ -12,42 +12,46 @@ use warnings;
use DynaLoader ();
-use Devel::Cover::Process 0.05;
+use Devel::Cover::DB 0.06;
our @ISA = qw( DynaLoader );
-our $VERSION = "0.05";
+our $VERSION = "0.06";
use B qw( class ppname main_root main_start main_cv svref_2object OPf_KIDS );
-use Data::Dumper;
my $Covering = 1;
+my $DB = "cover_db";
+my $Details = 0;
+my $Merge = 1;
+my @Inc;
my $Indent = 0;
-my $Output = "default.cov";
my $Summary = 1;
-my $Details = 0;
my %Cover;
our $Cv; # gets localised
my @Todo;
my %Done;
-my @Inc;
BEGIN { @Inc = @INC }
+# BEGIN { $^P = 0x02 | 0x04 | 0x100 }
+BEGIN { $^P = 0x04 | 0x100 }
END { report() }
sub import
{
my $class = shift;
+ @Inc = () if "@_" =~ /-inc /;
while (@_)
{
local $_ = shift;
- /^-indent/ && do { $Indent = shift; next };
- /^-output/ && do { $Output = shift; next };
+ /^-db/ && do { $DB = shift; next };
+ /^-details/ && do { $Details = shift; next };
+ /^-merge/ && do { $Merge = shift; next };
/^-inc/ && do { push @Inc, shift; next };
+ /^-indent/ && do { $Indent = shift; next };
/^-summary/ && do { $Summary = shift; next };
- /^-details/ && do { $Details = shift; next };
warn __PACKAGE__ . ": Unknown option $_ ignored\n";
}
}
@@ -68,8 +72,8 @@ sub report
INC:
while (my ($name, $file) = each %INC)
{
- for (@Inc) { next INC if $file =~ /^\Q$_/ }
# print "$name => $file\n";
+ for (@Inc) { next INC if $file =~ /^\Q$_/ }
$name =~ s/\.pm$//;
$name =~ s/\//::/g;
get_subs($name);
@@ -91,34 +95,45 @@ sub report
for (@Inc) { delete $Cover{$file}, last if $file =~ /^\Q$_/ }
}
- {
- local $Data::Dumper::Indent = $Indent;
- open OUT, ">$Output" or die "Cannot open $Output\n";
- print OUT Data::Dumper->Dump([\%Cover], ["cover"]);
- close OUT or die "Cannot close $Output\n";
- }
-
- my $cover = Devel::Cover::Process->new(cover => \%Cover);
+ my $cover = Devel::Cover::DB->new(cover => \%Cover);
+ my $existing;
+ eval { $existing = Devel::Cover::DB->new(db => $DB) if $Merge };
+ $cover->merge($existing) if $existing;
+ $cover->indent($Indent);
+ $cover->write($DB);
$cover->print_summary if $Summary;
$cover->print_details if $Details;
}
my ($F, $L) = ("", 0);
-my $Level = 0;
+# my $Level = 0;
+
+sub get_location
+{
+ my ($op) = @_;
+
+ $F = $op->file;
+ $L = $op->line;
+
+ # If there's an eval, get the real filename. Enabled from $^P & 0x100.
+
+ ($F, $L) = ($1, $2) if $F =~/^\(eval \d+\)\[(.*):(\d+)\]/;
+}
sub walk_topdown
{
my ($op) = @_;
my $class = class($op);
my $cover = coverage()->{pack "I*", $$op};
- $Level++;
+ # $Level++;
# Statement coverage.
if ($class eq "COP")
{
- push @{$Cover{$F = $op->file}{statement}{$L = $op->line}}, $cover || 0
+ get_location($op);
+ push @{$Cover{$F}{statement}{$L}}, $cover || 0;
}
elsif (!null($op) &&
$op->name eq "null"
@@ -130,7 +145,8 @@ sub walk_topdown
$cover = coverage()->{pack "I*", ${$op->sibling}};
my $o = $op;
bless $o, "B::COP";
- push @{$Cover{$F = $o->file}{statement}{$L = $o->line}}, $cover || 0
+ get_location($o);
+ push @{$Cover{$F}{statement}{$L}}, $cover || 0;
}
# print " " x ($Level * 2), "$F:$L ", $op->name, ":$class\n";
@@ -153,7 +169,7 @@ sub walk_topdown
walk_topdown($op->pmreplroot);
}
- $Level--;
+ # $Level--;
$class eq "LISTOP" ? undef : $cover
}
@@ -263,7 +279,7 @@ Devel::Cover - Code coverage metrics for Perl
=head1 SYNOPSIS
perl -MDevel::Cover prog args
- perl -MDevel::Cover=-output,prog.cov,-indent,1,-details,1 prog args
+ perl -MDevel::Cover=-db,cover_db,-indent,1,-details,1 prog args
=head1 DESCRIPTION
@@ -288,11 +304,12 @@ Requirements:
=head1 OPTIONS
- -indent indent - Set indentation level to indent. See Data::Dumper for details.
- -output file - Send output to file (default default.cov).
+ -db cover_db - Store results in coverage db (default cover_db).
+ -details val - Print detailed information iff val is true (default off).
-inc path - Prefix of files to ignore (default @INC).
+ -indent indent - Set indentation level to indent. See Data::Dumper for details.
+ -merge val - Merge databases, for multiple test benches (default on).
-summary val - Print summary information iff val is true (default on).
- -details val - Print detailed information iff val is true (default off).
=head1 TUTORIAL
@@ -476,7 +493,7 @@ Huh?
=head1 VERSION
-Version 0.05 - 9th May 2001
+Version 0.06 - 10th May 2001
=head1 LICENCE
@@ -5,14 +5,18 @@
# The latest version of this software should be available from my homepage:
# http://www.pjcj.net
-package Devel::Cover::Process;
+package Devel::Cover::DB;
use strict;
use warnings;
use Carp;
+use Data::Dumper;
+use File::Path;
-our $VERSION = "0.05";
+our $VERSION = "0.06";
+
+my $DB = "cover.1"; # Version 1 of the database.
sub new
{
@@ -22,32 +26,36 @@ sub new
{
criteria => [ qw( statement branch path condition ) ],
criteria_short => [ qw( stmt branch path cond ) ],
+ indent => 1,
+ cover => {},
@_
};
$self->{all_criteria} = [ @{$self->{criteria}}, "total" ];
$self->{all_criteria_short} = [ @{$self->{criteria_short}}, "total" ];
bless $self, $class;
- if (defined $self->{file})
+ my $file;
+ if (defined $self->{db})
{
- open F, "<$self->{file}" or croak "Unable to open $self->{file}: $!";
+ $self->validate_db;
+ $file = "$self->{db}/$DB";
+ open F, "<$file" or croak "Unable to open $file: $!";
$self->{filehandle} = *F{IO};
}
$self->read if defined $self->{filehandle};
- if (defined $self->{file})
+ if (defined $file)
{
- close F or croak "Unable to close $self->{file}: $!";
+ close F or croak "Unable to close $file: $!";
}
- croak "No input file, filehandle or cover" unless defined $self->{cover};
+ croak "No input db, filehandle or cover" unless defined $self->{cover};
$self
}
-
sub read
{
my $self = shift;
@@ -56,16 +64,115 @@ sub read
my $fh = $self->{filehandle};
eval <$fh>;
croak $@ if $@;
- $self->{cover} = $cover
+ $self->{cover} = $cover;
+ $self
}
+sub write
+{
+ my $self = shift;
+ $self->{db} = shift if @_;
+ croak "No db specified" unless length $self->{db};
+ $self->validate_db;
+ local $Data::Dumper::Indent = $self->indent;
+ my $file = "$self->{db}/$DB";
+ open OUT, ">$file" or croak "Cannot open $file\n";
+ print OUT Data::Dumper->Dump([$self->{cover}], ["cover"]);
+ close OUT or croak "Cannot close $file\n";
+ $self
+}
+
+sub delete
+{
+ my $self = shift;
+ $self->{db} = shift if @_;
+ croak "No db specified" unless length $self->{db};
+ rmtree($self->{db});
+ $self
+}
sub cover
{
my $self = shift;
$self->{cover}
}
+sub validate_db
+{
+ my $self = shift;
+ unless (-d $self->{db})
+ {
+ mkdir $self->{db}, 0777 or croak "Cannot mkdir $self->{db}: $!\n";
+ }
+ $self
+}
+
+sub indent
+{
+ my $self = shift;
+ $self->{indent} = shift if @_;
+ $self->{indent}
+}
+
+sub merge
+{
+ my ($self, $from) = @_;
+ _merge_hash($self->cover, $from->cover);
+ $self
+}
+
+sub _merge_hash
+{
+ my ($into, $from) = @_;
+ for my $fkey (keys %{$from})
+ {
+ my $fval = $from->{$fkey};
+ my $fval_ref = ref $fval;
+
+ if (defined $into->{$fkey} and UNIVERSAL::isa($into->{$fkey}, "ARRAY"))
+ {
+ _merge_array($into->{$fkey}, $fval);
+ }
+ elsif (defined $fval && UNIVERSAL::isa($fval, "HASH"))
+ {
+ if (defined $into->{$fkey} and
+ UNIVERSAL::isa($into->{$fkey}, "HASH"))
+ {
+ _merge_hash($into->{$fkey}, $fval);
+ }
+ else
+ {
+ $into->{$fkey} = $fval;
+ }
+ }
+ else
+ {
+ # A scalar (or a blessed scalar). We know there is no into
+ # array, or we would just have merged with it.
+
+ $into->{$fkey} = $fval;
+ }
+ }
+}
+
+sub _merge_array
+{
+ my ($into, $from) = @_;
+ for my $i (@$into)
+ {
+ my $f = shift @$from;
+ if (UNIVERSAL::isa($i, "ARRAY"))
+ {
+ _merge_array($i, $f);
+ }
+ else
+ {
+ $i += $f;
+ }
+ }
+ push @$into, @$from;
+}
+
sub calculate_summary
{
my $self = shift;
@@ -113,6 +220,13 @@ sub calculate_summary
}
}
+sub trimmed_file
+{
+ my ($f, $len) = @_;
+ substr $f, 0, 3 - $len, "..." if length $f > $len;
+ $f
+}
+
sub print_summary
{
my $self = shift;
@@ -138,7 +252,7 @@ sub print_summary
for my $file (grep($_ ne "Total", sort keys %$s), "Total")
{
printf $fmt,
- $file,
+ trimmed_file($file, 42),
map { $format->($s->{$file}, $_) } @{$self->{all_criteria}};
}
Oops, something went wrong.

0 comments on commit 2202197

Please sign in to comment.