Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

import Devel::Cover 0.39

  • Loading branch information...
commit c48323665a7d73a0de47c24c6fc261b82c815245 1 parent 32cd545
@pjcj authored
Showing with 526 additions and 364 deletions.
  1. +7 −0 CHANGES
  2. +1 −0  MANIFEST
  3. +1 −1  META.yml
  4. +27 −3 Makefile.PL
  5. +1 −0  TODO
  6. +1 −1  all_versions
  7. +3 −4 cover
  8. +6 −7 cpancover
  9. +2 −2 create_gold
  10. +4 −4 gcov2perl
  11. +64 −63 lib/Devel/Cover.pm
  12. +2 −2 lib/Devel/Cover/Branch.pm
  13. +2 −2 lib/Devel/Cover/Condition.pm
  14. +2 −2 lib/Devel/Cover/Condition_and_3.pm
  15. +2 −2 lib/Devel/Cover/Condition_or_2.pm
  16. +2 −2 lib/Devel/Cover/Condition_or_3.pm
  17. +2 −2 lib/Devel/Cover/Condition_xor_4.pm
  18. +13 −21 lib/Devel/Cover/Criterion.pm
  19. +135 −88 lib/Devel/Cover/DB.pm
  20. +4 −5 lib/Devel/Cover/DB/File.pm
  21. +131 −0 lib/Devel/Cover/DB/Structure.pm
  22. +2 −2 lib/Devel/Cover/Op.pm
  23. +2 −2 lib/Devel/Cover/Pod.pm
  24. +2 −2 lib/Devel/Cover/Report/Html.pm
  25. +5 −5 lib/Devel/Cover/Report/Html_basic.pm
  26. +5 −9 lib/Devel/Cover/Report/Html_minimal.pm
  27. +6 −6 lib/Devel/Cover/Report/Html_subtle.pm
  28. +3 −3 lib/Devel/Cover/Report/Text.pm
  29. +3 −3 lib/Devel/Cover/Report/Text2.pm
  30. +6 −6 lib/Devel/Cover/Statement.pm
  31. +7 −7 lib/Devel/Cover/Subroutine.pm
  32. +10 −7 lib/Devel/Cover/Test.pm
  33. +6 −6 lib/Devel/Cover/Time.pm
  34. +2 −2 lib/Devel/Cover/Truth_Table.pm
  35. +1 −1  lib/Devel/Cover/Tutorial.pod
  36. +1 −1  test_output/cover/alias.5.006001
  37. +1 −1  test_output/cover/alias1.5.006001
  38. +1 −1  test_output/cover/branch_return_sub.5.006001
  39. +1 −1  test_output/cover/cond_and.5.006001
  40. +1 −1  test_output/cover/cond_branch.5.006001
  41. +1 −1  test_output/cover/cond_or.5.006001
  42. +1 −1  test_output/cover/cond_xor.5.006001
  43. +1 −1  test_output/cover/default_param.5.006001
  44. +1 −1  test_output/cover/destroy.5.006001
  45. +1 −1  test_output/cover/dynamic_subs.5.006001
  46. +1 −1  test_output/cover/eval1.5.006001
  47. +20 −17 test_output/cover/fork.5.006001
  48. +1 −1  test_output/cover/if.5.006001
  49. +1 −1  test_output/cover/module1.5.006001
  50. +1 −1  test_output/cover/module2.5.006001
  51. +1 −1  test_output/cover/module_import.5.006001
  52. +1 −1  test_output/cover/overloaded.5.006001
  53. +1 −44 test_output/cover/pod.5.006001
  54. +1 −1  test_output/cover/skip.5.006001
  55. +1 −1  test_output/cover/special_blocks.5.006001
  56. +5 −5 test_output/cover/statement.5.006001
  57. +1 −1  test_output/cover/t0.5.006001
  58. +1 −1  test_output/cover/t1.5.006001
  59. +1 −1  test_output/cover/t2.5.006001
  60. +1 −1  test_output/cover/trivial.5.006001
  61. +3 −0  tests/fork
  62. +2 −2 tests/md5.t
  63. +1 −2  tests/statement
View
7 CHANGES
@@ -248,3 +248,10 @@ Release 0.38 - 12th March 2004
- Add default_param test.
- Provide summary output to one decimal place.
- Update gcov2perl.
+
+Release 0.39 - 22nd March 2004
+ - Major database rework to store runs.
+ - Add Devel::Cover::DB::Structure.pm.
+ - Check for Test::Differences in Makefile.PL.
+ - Test with perl5.9.2.
+ - Skip fork test on MSWin32.
View
1  MANIFEST
@@ -20,6 +20,7 @@ lib/Devel/Cover/Subroutine.pm
lib/Devel/Cover/Pod.pm
lib/Devel/Cover/Time.pm
lib/Devel/Cover/DB/File.pm
+lib/Devel/Cover/DB/Structure.pm
lib/Devel/Cover/Test.pm
lib/Devel/Cover/Report/Text.pm
lib/Devel/Cover/Report/Html.pm
View
2  META.yml
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Devel-Cover
-version: 0.38
+version: 0.39
version_from:
installdirs: site
requires:
View
30 Makefile.PL
@@ -19,8 +19,8 @@ use File::Copy;
$| = 1;
-my $Version = "0.38";
-my $Date = "12th March 2004";
+my $Version = "0.39";
+my $Date = "22nd March 2004";
my $Author = 'pjcj@cpan.org';
my @perlbug = ("perlbug", "-a", $Author,
@@ -196,6 +196,30 @@ else
print "not found\n\n$e\n";
}
+print "checking for Test::Differences.pm ........ ";
+
+$e = <<EOM;
+
+Test::Differences.pm is to display output from failed tests. Hopefully
+there won't be any failed tests, but if there are you will get output
+that may not be a model of clarity. If you do get test failures and you
+fancy helping me by debugging them, then you might like to consider
+installing Test::Differences. You can download Test::Differences from
+CPAN.
+
+EOM
+
+eval "use Test::Differences";
+if (my $m = $INC{"Test/Differences.pm"})
+{
+ my $v = eval { no warnings; $Test::Differences::VERSION };
+ print "$v $m\n";
+}
+else
+{
+ print "not found\n\n$e\n";
+}
+
my $latest_tested = 5.008003;
print <<EOM if $] > $latest_tested;
@@ -313,7 +337,7 @@ FONT = "Bitstream Vera Sans Mono 8"
diff : _run
\t \$(PERL) -i -pe '\$\$t = index \$\$_, "time code" if !defined \$\$t || \$\$t < 0; substr \$\$_, \$\$t, 7, "" if /^line err stmt/ .. /^Branches/ and length > \$\$t' \$(TEST).out
-\t gvim -d -font \$(FONT) `\$(PERL) -Mblib -MDevel::Cover::Test -e '\$\$t = Devel::Cover::Test->new(\$(TEST)); print \$\$t->cover_gold'` \$(TEST).out
+\t gvim -d -font \$(FONT) `\$(PERL) -Mblib -MDevel::Cover::Test -e '\$\$t = Devel::Cover::Test->new("\$(TEST)"); print \$\$t->cover_gold'` \$(TEST).out
gold : pure_all
\t \$(PERL) create_gold \$(TEST)
View
1  TODO
@@ -23,3 +23,4 @@
- Threads support.
- Test analysis.
- Move HTML version and platform info to main page and allow for multiples.
+- Fix up shebang line on tests.
View
2  all_versions
@@ -29,7 +29,7 @@ sub get_options
version=s
));
$Options->{version} =
- [ qw( 5.6.1 5.6.2 5.8.0 5.8.1 5.8.2 5.8.3 5.9.0 5.9.1 ) ]
+ [ qw( 5.6.1 5.6.2 5.8.0 5.8.1 5.8.2 5.8.3 5.9.0 5.9.1 5.9.2 ) ]
unless @{$Options->{version}};
$Options->{version} =
[ grep eval { !system "perl$_ -v" }, @{$Options->{version}} ];
View
7 cover
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
-use Devel::Cover::DB 0.38;
+use Devel::Cover::DB 0.39;
use Cwd "abs_path";
use Data::Dumper;
@@ -165,7 +165,6 @@ sub main
delete @f{map glob, @{$Options->{exclude}}};
@{$Options->{file}} = sort grep exists $db->{summary}{$_}, keys %f;
- # use Data::Dumper; print Dumper $Options;
$format->report($db, $Options)
}
@@ -259,7 +258,7 @@ See the BUGS file.
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
13 cpancover
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
-use Devel::Cover::DB 0.38;
+use Devel::Cover::DB 0.39;
use Cwd ();
use File::Find ();
@@ -283,8 +283,7 @@ sub write_html
File::Find::find($func, $mod);
}
- # use Data::Dumper;
- # print Dumper $vars;
+ # use Data::Dumper; print Dumper $vars;
write_stylesheet;
$Template->process("summary", $vars, $f) or die $Template->error();
@@ -314,7 +313,7 @@ package Devel::Cover::Cpancover::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Template::Provider";
@@ -350,7 +349,7 @@ $Templates{html} = <<'EOT';
<!--
-This file was generated by Devel::Cover Version 0.38
+This file was generated by Devel::Cover Version 0.39
Devel::Cover is copyright 2001-2004, Paul Johnson (pjcj@cpan.org)
@@ -459,7 +458,7 @@ The following exit values are returned:
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
4 create_gold
@@ -12,11 +12,11 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use blib;
-use Devel::Cover::Test 0.38;
+use Devel::Cover::Test 0.39;
my @tests = @ARGV;
View
8 gcov2perl
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
-use Devel::Cover::DB 0.38;
+use Devel::Cover::DB 0.39;
use Getopt::Long;
use Pod::Usage;
@@ -55,7 +55,7 @@ sub add_cover
s/\s+//g;
$_ = 0 if $_ eq "######";
next if !length || /\D/;
- $cover->{$f}{statement}{$.} = [[[$_]]];
+ $cover->{$f}{statement}{$.} = [\$_];
}
close F or die "Can't open $file: $!\n";
}
@@ -123,7 +123,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
127 lib/Devel/Cover.pm
@@ -10,13 +10,13 @@ package Devel::Cover;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use DynaLoader ();
our @ISA = qw( DynaLoader );
-use Devel::Cover::DB 0.38;
-use Devel::Cover::Inc 0.38;
+use Devel::Cover::DB 0.39;
+use Devel::Cover::Inc 0.39;
use B qw( class ppname main_cv main_start main_root walksymtable OPf_KIDS );
use B::Debug;
@@ -48,12 +48,12 @@ my @Cvs; # All the Cvs we want to cover.
my $Cv; # Cv we are looking in.
my $Coverage; # Raw coverage data.
-my $Cover; # Coverage data.
+my $Structure; # Structure of the files.
my %Criteria; # Names of coverage criteria.
my %Coverage; # Coverage criteria to collect.
-my %Meta; # Meta data collected from the run.
+my %Run; # Data collected from the run.
use vars '$File', # Last filename we saw. (localised)
'$Line', # Last line number we saw. (localised)
@@ -81,9 +81,6 @@ CHECK
check_files();
- # reset_op_seq(main_root);
- # reset_op_seq($_->ROOT) for @Cvs;
-
set_coverage(keys %Coverage);
my @coverage = get_coverage();
%Coverage = map { $_ => 1 } @coverage;
@@ -112,10 +109,10 @@ EOM
"Ignoring packages in:", join("\n ", "", @Inc), "\n"
unless $Silent;
- $Meta{OS} = $^O;
- $Meta{perl} = join ".", map ord, split //, $^V;
- $Meta{run} = $0;
- $Meta{start} = get_elapsed();
+ $Run{OS} = $^O;
+ $Run{perl} = join ".", map ord, split //, $^V;
+ $Run{run} = $0;
+ $Run{start} = get_elapsed();
}
}
@@ -273,9 +270,8 @@ sub get_location
$File =~ s/^$Dir\///;
$File_cache{$file} = $File;
- @{$Meta{vec}{$File}{$_}}{"vec", "size"} = ("", 0)
- for grep $_ ne "time", @{$Meta{collected}};
- # use Data::Dumper; print Dumper \%Meta;
+ @{$Run{vec}{$File}{$_}}{"vec", "size"} = ("", 0)
+ for grep $_ ne "time", @{$Run{collected}};
# warn "File: $file => $File\n";
}
@@ -286,7 +282,7 @@ sub use_file
$file = $1 if $file =~ /^\(eval \d+\)\[(.*):\d+\]/;
$file =~ s/ \(autosplit into .*\)$//;
- $file =~ s|\.\./\.\./lib/POSIX.pm|$INC{"POSIX.pm"}|e; # TODO - fix
+ $file =~ s|\.\./\.\./lib/POSIX.pm|$INC{"POSIX.pm"}|e;
# TODO - check - probably fixed by merging on MD5 sums.
my $files = \%Files;
@@ -346,14 +342,11 @@ sub check_files
my %cvs = map { $$_ => $_ } @Cvs;
@Cvs = values %cvs;
-
- # print Dumper \%seen_pkg;
- # print Dumper \%Files;
}
sub report
{
- $Meta{finish} = get_elapsed();
+ $Run{finish} = get_elapsed();
die "Devel::Cover::import() not run: " .
"did you require instead of use Devel::Cover?\n"
@@ -362,11 +355,11 @@ sub report
chdir $Dir or die __PACKAGE__ . ": Can't chdir $Dir: $!\n";
my @collected = get_coverage();
- # print "Collected @collected\n";
return unless @collected;
set_coverage("none");
- $Meta{collected} = \@collected;
+ $Run{collected} = \@collected;
+ $Structure = Devel::Cover::DB::Structure->new;
# print "Processing cover data\n@Inc\n";
@@ -377,52 +370,58 @@ sub report
check_files();
get_cover(main_cv, main_root);
- # print "init, ", Dumper \B::begin_av;
- # print "init array, ", Dumper B::begin_av->ARRAY;
get_cover($_) for B::begin_av->isa("B::AV") ? B::begin_av->ARRAY : ();
get_cover($_) for B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
get_cover($_) for B::init_av ->isa("B::AV") ? B::init_av ->ARRAY : ();
get_cover($_) for B::end_av ->isa("B::AV") ? B::end_av ->ARRAY : ();
get_cover($_) for @Cvs;
- for my $file (keys %$Cover)
+ for my $file (keys %{$Run{count}})
{
my $use = use_file($file);
# warn sprintf "%-4s using $file\n", $use ? "" : "not";
unless ($use)
{
- delete $Cover->{$file};
+ delete $Run{count}->{$file};
+ delete $Run{vec} ->{$file};
next;
}
if (open my $fh, "<", $file)
{
binmode $fh;
- $Cover->{$file}{meta}{digest} =
- Digest::MD5->new->addfile($fh)->hexdigest;
- # print STDERR "md5sum of <$file> is <$Cover->{$file}{meta}{digest}>\n";
+ $Run{digest}{$file} = Digest::MD5->new->addfile($fh)->hexdigest;
+ $Structure->set_digest($file, $Run{digest}{$file});
}
else
{
warn __PACKAGE__ . ": Can't open $file for MD5 digest: $!\n";
}
+
+ for my $run (keys %{$Run{vec}{$file}})
+ {
+ delete $Run{vec}{$file}{$run} unless $Run{vec}{$file}{$run}{size};
+ }
}
+ my $run = time . ".$$." . sprintf "%05d", rand 2 ** 16;
my $cover = Devel::Cover::DB->new
(
- cover => $Cover,
- meta => { $Meta{run} => \%Meta }
+ base => $DB,
+ runs => { $run => \%Run },
+ structure => $Structure,
);
$DB .= "/runs";
mkdir $DB unless -d $DB;
- $DB .= "/" . time . ".$$." . sprintf "%05d", rand 2 ** 16;
+ $DB .= "/$run";
+
+ $cover->{db} = $DB;
- $cover->merge_identical_files;
print STDOUT __PACKAGE__, ": Writing coverage database to $DB\n"
unless $Silent;
- $cover->write($DB);
+ $cover->write;
$cover->print_summary if $Summary && !$Silent;
}
@@ -443,10 +442,10 @@ sub add_subroutine_cover
my $key = get_key($op);
my $val = $Coverage->{statement}{$key} || 0;
- push @{$Cover->{$File}{subroutine}{$Line}}, [[$val, $sub_name]];
- my $vec = $Meta{vec}{$File}{subroutine};
+ $Structure->add_subroutine($File, [ $Line, $sub_name ]);
+ push @{$Run{count}{$File}{subroutine}}, $val;
+ my $vec = $Run{vec}{$File}{subroutine};
vec($vec->{vec}, $vec->{size}++, 1) = $val ? 1 : 0;
- # print "$File:$Line:$sub_name: $val\n";
}
sub add_statement_cover
@@ -460,10 +459,11 @@ sub add_statement_cover
my $key = get_key($op);
my $val = $Coverage->{statement}{$key} || 0;
- push @{$Cover->{$File}{statement}{$Line}}, [[$val]];
- my $vec = $Meta{vec}{$File}{statement};
+ $Structure->add_statement($File, $Line);
+ push @{$Run{count}{$File}{statement}}, $val;
+ my $vec = $Run{vec}{$File}{statement};
vec($vec->{vec}, $vec->{size}++, 1) = $val ? 1 : 0;
- push @{$Cover->{$File}{time}{$Line}}, [[$Coverage->{time}{$key}]]
+ push @{$Run{count}{$File}{time}}, $Coverage->{time}{$key}
if exists $Coverage->{time} && exists $Coverage->{time}{$key};
}
@@ -478,10 +478,8 @@ sub add_branch_cover
my $key = get_key($op);
# print STDERR "Branch cover from $file:$line $type:$text\n";
- # use Carp "cluck"; cluck "here: ";
my $c = $Coverage->{condition}{$key};
- # use Data::Dumper; print "Coverage $type: $text\n", Dumper \@$c;
no warnings "uninitialized";
@@ -501,10 +499,12 @@ sub add_branch_cover
$c = $Coverage->{branch}{$key} || [0, 0];
}
- my $vec = $Meta{vec}{$File}{branch};
+ my $vec = $Run{vec}{$File}{branch};
vec($vec->{vec}, $vec->{size}++, 1) = $_ ||= 0 ? 1 : 0 for @$c;
- push @{$Cover->{$file}{branch}{$line}}, [ $c, { text => $text } ];
+ my $structure = { text => $text };
+ $Structure->add_branch($file, [ $line, $structure ]);
+ push @{$Run{count}{$file}{branch}}, $c;
}
my %condition_locations;
@@ -529,8 +529,6 @@ sub add_condition_cover
$type =~ s/assign$//;
my $c = $Coverage->{condition}{$key};
- # use Data::Dumper; print "Condition Coverage $type\n", Dumper \@$c;
- # shift @$c;
no warnings "uninitialized";
@@ -566,19 +564,19 @@ sub add_condition_cover
die qq(Unknown type "$type" for conditional);
}
- my $vec = $Meta{vec}{$File}{condition};
+ my $vec = $Run{vec}{$File}{condition};
vec($vec->{vec}, $vec->{size}++, 1) = $_ ||= 0 ? 1 : 0 for @$c;
- push @{$Cover->{$File}{condition}{$Line}},
- [
- $c,
- {
- type => "${type}_${count}",
- op => $strop,
- left => $left,
- right => $right,
- },
- ];
+ my $structure =
+ {
+ type => "${type}_${count}",
+ op => $strop,
+ left => $left,
+ right => $right,
+ };
+
+ $Structure->add_condition($File, [ $Line, $structure ]);
+ push @{$Run{count}{$File}{condition}}, $c;
}
sub is_scope { &B::Deparse::is_scope }
@@ -739,7 +737,6 @@ sub get_cover
$sub_name =~ s/(__ANON__)\[.+:\d+\]/$1/ if defined $sub_name;
# printf STDERR "getting cover for $sub_name, %x\n", $$cv;
- # use Carp "cluck"; cluck "here: ";
if ($Pod && $Coverage{pod})
{
@@ -763,9 +760,13 @@ sub get_cover
$covered = 0, last if $_ eq $sub_name;
}
}
- $Cover->{$File}{pod} ||= {};
- push @{$Cover->{$File}{pod}{$Line}[0]}, $covered
- if defined $covered;
+ if (defined $covered)
+ {
+ $Structure->add_pod($File, [ $Line, $sub_name ]);
+ push @{$Run{count}{$File}{pod}}, $covered;
+ my $vec = $Run{vec}{$File}{pod};
+ vec($vec->{vec}, $vec->{size}++, 1) = $covered ? 1 : 0;
+ }
}
}
}
@@ -773,7 +774,7 @@ sub get_cover
my $root = $cv->ROOT;
# use Devel::Peek;
# print Dump B::svref_2object($cv); print Dump B::svref_2object($root);
- if ($root->can("first"))
+ if ($Coverage{subroutine} && $root->can("first"))
{
my $lineseq = $root->first;
add_subroutine_cover($lineseq->first, $sub_name)
@@ -987,7 +988,7 @@ See the BUGS file.
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
4 lib/Devel/Cover/Branch.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Branch;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Criterion";
@@ -76,7 +76,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
4 lib/Devel/Cover/Condition.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Condition;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Criterion";
@@ -80,7 +80,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
4 lib/Devel/Cover/Condition_and_3.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_and_3;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
4 lib/Devel/Cover/Condition_or_2.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_or_2;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
4 lib/Devel/Cover/Condition_or_3.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_or_3;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
4 lib/Devel/Cover/Condition_xor_4.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_xor_4;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Condition";
@@ -45,7 +45,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
34 lib/Devel/Cover/Criterion.pm
@@ -10,26 +10,18 @@ package Devel::Cover::Criterion;
use strict;
use warnings;
-our $VERSION = "0.38";
-
-use Devel::Cover::Statement 0.38;
-use Devel::Cover::Branch 0.38;
-use Devel::Cover::Condition 0.38;
-use Devel::Cover::Condition_or_2 0.38;
-use Devel::Cover::Condition_or_3 0.38;
-use Devel::Cover::Condition_and_3 0.38;
-use Devel::Cover::Condition_xor_4 0.38;
-use Devel::Cover::Subroutine 0.38;
-use Devel::Cover::Time 0.38;
-use Devel::Cover::Pod 0.38;
-
-sub new
-{
- my $class = shift;
- my $self = [];
-
- bless $self, $class
-}
+our $VERSION = "0.39";
+
+use Devel::Cover::Statement 0.39;
+use Devel::Cover::Branch 0.39;
+use Devel::Cover::Condition 0.39;
+use Devel::Cover::Condition_or_2 0.39;
+use Devel::Cover::Condition_or_3 0.39;
+use Devel::Cover::Condition_and_3 0.39;
+use Devel::Cover::Condition_xor_4 0.39;
+use Devel::Cover::Subroutine 0.39;
+use Devel::Cover::Time 0.39;
+use Devel::Cover::Pod 0.39;
sub coverage { $_[0][0] }
sub information { $_[0][1] }
@@ -79,7 +71,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
223 lib/Devel/Cover/DB.pm
@@ -10,16 +10,17 @@ package Devel::Cover::DB;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
-use Devel::Cover::DB::File 0.38;
-use Devel::Cover::Criterion 0.38;
+use Devel::Cover::Criterion 0.39;
+use Devel::Cover::DB::File 0.39;
+use Devel::Cover::DB::Structure 0.39;
use Carp;
use File::Path;
use Storable;
-my $DB = "cover.8"; # Version 8 of the database.
+my $DB = "cover.10"; # Version 10 of the database.
sub new
{
@@ -30,17 +31,14 @@ sub new
[ qw( statement branch path condition subroutine pod time ) ],
criteria_short =>
[ qw( stmt branch path cond sub pod time ) ],
- meta => {},
- cover => {},
+ runs => {},
+ collected => {},
@_
};
$self->{all_criteria} = [ @{$self->{criteria}}, "total" ];
$self->{all_criteria_short} = [ @{$self->{criteria_short}}, "total" ];
- my ($run) = keys %{$self->{meta}};
- $self->{meta}{collected} = {};
- @{$self->{meta}{collected}}{@{$self->{meta}{$run}{collected}}} = ()
- if defined $run;
+ $self->{base} ||= $self->{db};
bless $self, $class;
my $file;
@@ -52,7 +50,7 @@ sub new
return $self unless -e $file;
}
- croak "No input db, filehandle or cover" unless defined $self->{cover};
+ # croak "No input db, filehandle or cover" unless defined $self->{cover};
$self
}
@@ -66,12 +64,8 @@ sub read
{
my $self = shift;
my $file = shift;
- # print "read $file\n";
my $db = retrieve($file);
-
- $self->{cover} = $db->{cover};
- $self->{meta} = $db->{meta};
-
+ $self->{runs} = $db->{runs};
$self
}
@@ -88,12 +82,13 @@ sub write
my $db =
{
- cover => $self->{cover},
- meta => $self->{meta},
+ runs => $self->{runs},
};
- # print "write $self->{db}/$DB\n";
Storable::nstore($db, "$self->{db}/$DB");
+
+ $self->{structure}->write($self->{base}) if $self->{structure};
+
$self
}
@@ -129,9 +124,9 @@ sub merge_runs
for my $run (sort @runs)
{
- print STDERR "Devel::Cover: merging run $run\n"
+ print STDERR "Devel::Cover: merging run $run <$self->{base}>\n"
unless $Devel::Cover::Silent;
- my $r = Devel::Cover::DB->new(db => $run);
+ my $r = Devel::Cover::DB->new(base => $self->{base}, db => $run);
rmtree($run);
$self->merge($r);
}
@@ -139,12 +134,6 @@ sub merge_runs
$self
}
-sub cover_files
-{
- my $self = shift;
- $self->{cover}
-}
-
sub validate_db
{
my $self = shift;
@@ -160,71 +149,43 @@ sub is_valid
sub collected
{
my $self = shift;
- sort keys %{$self->{meta}{collected}}
-}
-
-sub merge_identical_files
-{
- my $self = shift;
-
- my $c = $self->cover_files;
- my %digests;
-
- for my $file (sort keys %$c)
- {
- my $d = $c->{$file}{meta}{digest};
- push @{$digests{$d}}, $file if $d;
- }
-
- # use Data::Dumper; print Dumper $c; print Dumper \%digests;
-
- for my $f (values %digests)
- {
- my $t = shift @$f;
- for my $s (@$f)
- {
- print STDERR "Devel::Cover: merging data for $s into $t\n";
- _merge_hash($c->{$t}, delete $c->{$s});
- $c->{$t}{meta}{aka}{$s} = 1;
- }
- }
+ $self->cover;
+ sort keys %{$self->{collected}}
}
sub merge
{
my ($self, $from) = @_;
- my $sf = $self->cover_files;
- my $ff = $from->cover_files;
-
- # use Data::Dumper; print STDERR "Merging\n",Dumper($sf), Dumper($ff);
+ # use Data::Dumper; print "Merging ", Dumper($self), "From ", Dumper($from);
- for my $file (keys %$ff)
+ while (my ($fname, $frun) = each %{$from->{runs}})
{
- my $sd = $sf->{$file}{meta}{digest};
- my $fd = $ff->{$file}{meta}{digest};
- if ($sd && $fd && $sd ne $fd)
+ while (my ($file, $digest) = each %{$frun->{digest}})
{
- # File has changed. Delete old coverage instead of merging.
- # TODO - Can't do coverage analysis, either.
- print STDERR "Devel::Cover: ",
- "Deleting old coverage for changed file $file\n"
- unless $Devel::Cover::Silent;
- delete $ff->{$file};
+ while (my ($name, $run) = each %{$self->{runs}})
+ {
+ if (exists $run->{digest}{$file} &&
+ $run->{digest}{$file} ne $digest)
+ {
+ # File has changed. Delete old coverage instead of merging.
+ print STDERR "Devel::Cover: Deleting old coverage for ",
+ "changed file $file\n"
+ unless $Devel::Cover::Silent;
+ delete $run->{digest}{$file};
+ delete $run->{count} {$file};
+ delete $run->{vec} {$file};
+ }
+ }
}
}
# When the database gets big, it's quicker to merge into what's
# already there.
- # use Data::Dumper; print STDERR Dumper $self->{meta};
- # my ($run) = grep $_ ne "collected", keys %{$self->{meta}};
- # $from->{meta}{runs}{$run} = delete $self->{meta}{$run} if defined $run;
+ _merge_hash($from->{runs}, $self->{runs});
+ _merge_hash($from->{collected}, $self->{collected});
- # use Data::Dumper; print STDERR Dumper $from->{meta};
- _merge_hash($from->{meta}, $self->{meta});
- # use Data::Dumper; print STDERR Dumper $from->{meta};
- _merge_hash($from->cover, $self->cover);
$_[0] = $from;
}
@@ -278,6 +239,11 @@ sub _merge_array
{
_merge_hash($i, $f || {});
}
+ elsif (UNIVERSAL::isa($i, "SCALAR") ||
+ !defined $i && UNIVERSAL::isa($f, "SCALAR") )
+ {
+ $$i += $$f;
+ }
else
{
if (defined $f)
@@ -298,12 +264,6 @@ sub _merge_array
push @$into, @$from;
}
-sub files
-{
- my $self = shift;
- (grep($_ ne "Total", sort @{$self->{summary}}), "Total")
-}
-
sub summary
{
my $self = shift;
@@ -319,16 +279,12 @@ sub calculate_summary
my $self = shift;
my %options = @_;
- return if defined $self->{summary} && !$options{force};
+ return if exists $self->{summary} > 0 && !$options{force};
my $s = $self->{summary} = {};
for my $file ($self->cover->items)
{
$self->cover->get($file)->calculate_summary($self, $file, \%options);
- }
-
- for my $file ($self->cover->items)
- {
$self->cover->get($file)->calculate_percentage($self, $s->{$file});
}
@@ -352,6 +308,7 @@ sub trimmed_file
sub print_summary
{
my $self = shift;
+
my %options = map(($_ => 1), @_ ? @_ : $self->collected);
$options{total} = 1 if keys %options;
@@ -397,12 +354,102 @@ sub print_summary
select $oldfh;
}
+sub add_statement
+{
+ my $self = shift;
+ my ($cc, $sc, $fc) = @_;
+ my %line;
+ for my $i (0 .. $#$fc)
+ {
+ my $l = $sc->[$i];
+ my $n = $line{$l}++;
+ $cc->{$l}[$n] ||= do { my $c; \$c };
+ ${$cc->{$l}[$n]} += $fc->[$i];
+ }
+}
+
+sub add_branch
+{
+ my $self = shift;
+ my ($cc, $sc, $fc) = @_;
+ my %line;
+ for my $i (0 .. $#$fc)
+ {
+ my $l = $sc->[$i][0];
+ my $n = $line{$l}++;
+ if (my $a = $cc->{$l}[$n])
+ {
+ $a->[0][0] += $fc->[$i][0];
+ $a->[0][1] += $fc->[$i][1];
+ }
+ else
+ {
+ $cc->{$l}[$n] = [ $fc->[$i], $sc->[$i][1] ];
+ }
+ }
+}
+
+sub add_subroutine
+{
+ my $self = shift;
+ my ($cc, $sc, $fc) = @_;
+ my %line;
+ for my $i (0 .. $#$fc)
+ {
+ my $l = $sc->[$i][0];
+ my $n = $line{$l}++;
+ if (my $a = $cc->{$l}[$n])
+ {
+ $a->[0] += $fc->[$i];
+ }
+ else
+ {
+ $cc->{$l}[$n] = [ $fc->[$i], $sc->[$i][1] ];
+ }
+ }
+}
+
+*add_condition = \&add_branch;
+*add_pod = \&add_subroutine;
+*add_time = \&add_statement;
+
sub cover
{
my $self = shift;
return $self->{cover} if $self->{cover_valid};
+ my %digests;
+ my %files;
+ my $cover = $self->{cover} = {};
+ while (my ($run, $r) = each %{$self->{runs}})
+ {
+ @{$self->{collected}}{@{$r->{collected}}} = ();
+ my $count = $r->{count};
+ while (my ($file, $f) = each %$count)
+ {
+ my $digest = $r->{digest}{$file};
+ print STDERR "Devel::Cover: merging data for $file ",
+ "into $digests{$digest}\n"
+ if !$files{$file}++ && $digests{$digest};
+ my $cf = $cover->{$digests{$digest} ||= $file} ||= {};
+ my $st = Devel::Cover::DB::Structure->new
+ (
+ base => $self->{base},
+ digest => $digest,
+ );
+ while (my ($criterion, $fc) = each %$f)
+ {
+ my $get = "get_$criterion";
+ my $sc = $st->$get;
+ next unless $sc;
+ my $cc = $cf->{$criterion} ||= {};
+ my $add = "add_$criterion";
+ $self->$add($cc, $sc, $fc);
+ }
+ }
+ }
+
unless (UNIVERSAL::isa($self->{cover}, "Devel::Cover::DB::Cover"))
{
bless $self->{cover}, "Devel::Cover::DB::Cover";
@@ -641,7 +688,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
9 lib/Devel/Cover/DB/File.pm
@@ -10,9 +10,9 @@ package Devel::Cover::DB::File;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
-use Devel::Cover::Criterion 0.38;
+use Devel::Cover::Criterion 0.39;
sub calculate_summary
{
@@ -39,8 +39,7 @@ sub calculate_percentage
my $self = shift;
my ($db, $s) = @_;
- # use Data::Dumper;
- # print STDERR Dumper $s;
+ # use Data::Dumper; print STDERR Dumper $s;
for my $criterion ($self->items)
{
@@ -78,7 +77,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
131 lib/Devel/Cover/DB/Structure.pm
@@ -0,0 +1,131 @@
+# Copyright 2004, 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
+
+package Devel::Cover::DB::Structure;
+
+use strict;
+use warnings;
+
+use Carp;
+use Storable;
+
+our $VERSION = "0.39";
+our $AUTOLOAD;
+
+sub new
+{
+ my $class = shift;
+ my $self = { @_ };
+
+ bless $self, $class;
+
+ $self->read if $self->{base} && $self->{digest};
+
+ $self
+}
+
+sub DESTROY {}
+
+sub AUTOLOAD
+{
+ my $func = $AUTOLOAD;
+ $func =~ s/.*:://;
+ my ($function, $criterion) = $func =~ /^(add|get)_(.*)/;
+ require Devel::Cover::DB;
+ croak "Undefined subroutine $func called"
+ unless $criterion &&
+ grep $_ eq $criterion, Devel::Cover::DB->new->criteria;
+ no strict "refs";
+ if ($function eq "get")
+ {
+ my $c = $criterion eq "time" ? "statement" : $criterion;
+ *$func = sub
+ {
+ my $self = shift;
+ $self->{$c}
+ };
+ }
+ else
+ {
+ *$func = sub
+ {
+ my $self = shift;
+ my $file = shift;
+ push @{$self->{$file}{$criterion}}, @_;
+ };
+ }
+ goto &$func
+}
+
+sub set_digest
+{
+ my $self = shift;
+ my ($file, $digest) = @_;
+ $self->{$file}{digest} = $digest;
+}
+
+sub write
+{
+ my $self = shift;
+ my ($dir) = @_;
+ $dir .= "/structure";
+ unless (-d $dir)
+ {
+ mkdir $dir, 0777 or croak "Cannot mkdir $dir: $!\n";
+ }
+ for my $file (sort keys %$self)
+ {
+ Storable::nstore($self->{$file}, "$dir/$self->{$file}{digest}");
+ }
+}
+
+sub read
+{
+ my ($self) = @_;
+ my $file = "$self->{base}/structure/$self->{digest}";
+ my $s = retrieve($file);
+ $_[0] = bless $s, ref $self
+}
+
+1
+
+__END__
+
+=head1 NAME
+
+Devel::Cover::DB::Structure - Code coverage metrics for Perl
+
+=head1 SYNOPSIS
+
+ use Devel::Cover::DB::Structure;
+
+=head1 DESCRIPTION
+
+=head1 SEE ALSO
+
+ Devel::Cover
+
+=head1 METHODS
+
+=head1 BUGS
+
+Huh?
+
+=head1 VERSION
+
+Version 0.39 - 22nd March 2004
+
+=head1 LICENCE
+
+Copyright 2001-2004, 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/Op.pm
@@ -12,7 +12,7 @@ require 5.8.0; # My patches to B::Concise didn't get released till 5.8.0.
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use Devel::Cover qw( -ignore blib -ignore \\wB\\w );
use B::Concise qw( set_style add_callback );
@@ -111,7 +111,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
4 lib/Devel/Cover/Pod.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Pod;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Criterion";
@@ -72,7 +72,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
4 lib/Devel/Cover/Report/Html.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Report::Html;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Report::Html_minimal";
@@ -45,7 +45,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
10 lib/Devel/Cover/Report/Html_basic.pm
@@ -10,9 +10,9 @@ package Devel::Cover::Report::Html_basic;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
-use Devel::Cover::DB 0.38;
+use Devel::Cover::DB 0.39;
use Template 2.00;
@@ -278,7 +278,7 @@ package Devel::Cover::Report::Html_basic::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Template::Provider";
@@ -314,7 +314,7 @@ $Templates{html} = <<'EOT';
<!--
-This file was generated by Devel::Cover Version 0.38
+This file was generated by Devel::Cover Version 0.39
Devel::Cover is copyright 2001-2002, Paul Johnson (pjcj@cpan.org)
@@ -533,7 +533,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
14 lib/Devel/Cover/Report/Html_minimal.pm
@@ -4,10 +4,10 @@ use strict;
use warnings;
use CGI;
use Getopt::Long;
-use Devel::Cover::DB 0.38;
-use Devel::Cover::Truth_Table 0.38;
+use Devel::Cover::DB 0.39;
+use Devel::Cover::Truth_Table 0.39;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
#-------------------------------------------------------------------------------
# Subroutine : get_coverage_for_line
@@ -255,7 +255,7 @@ sub print_html_header {
print $fh <<"END_HTML";
<!--
-This file was generated by Devel::Cover Version 0.38
+This file was generated by Devel::Cover Version 0.39
Devel::Cover is copyright 2001-2004, Paul Johnson (pjcj\@cpan.org)
Devel::Cover is free. It is licensed under the same terms as Perl itself.
The latest version of Devel::Cover should be available from my homepage:
@@ -291,8 +291,6 @@ sub print_summary {
my $class = pclass($percent);
my $meta = $db->{meta}{$file};
- my $start = localtime ${meta}->{start} / 1e6;
- my $finish = localtime ${meta}->{finish} / 1e6;
print $fh <<"END_HTML";
<body>
@@ -300,8 +298,6 @@ sub print_summary {
<table>
<tr><td class="h" align="right">File:</td><td align="left">$file</td></tr>
<tr><td class="h" align="right">Coverage:</td><td align="left" class="$class">$percent\%</td></tr>
-<tr><td class="h" align="right">Platform:</td><td align="left">$meta->{OS}</td></tr>
-<tr><td class="h" align="right">Perl version:</td><td align="left">$meta->{perl}</td></tr>
</table>
<div><br/></div>
<table>
@@ -763,7 +759,7 @@ Devel::Cover
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
12 lib/Devel/Cover/Report/Html_subtle.pm
@@ -2,10 +2,10 @@ package Devel::Cover::Report::Html_subtle;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
-use Devel::Cover::DB 0.38;
-use Devel::Cover::Truth_Table 0.38;
+use Devel::Cover::DB 0.39;
+use Devel::Cover::Truth_Table 0.39;
use Template 2.00;
use CGI;
@@ -386,7 +386,7 @@ package Devel::Cover::Report::Html_subtle::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Template::Provider";
@@ -404,7 +404,7 @@ sub fetch {
$Templates{html} = <<'EOT';
<!--
-This file was generated by Devel::Cover Version 0.38
+This file was generated by Devel::Cover Version 0.39
Devel::Cover is copyright 2001-2002, Paul Johnson (pjcj@cpan.org)
@@ -734,7 +734,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
6 lib/Devel/Cover/Report/Text.pm
@@ -10,9 +10,9 @@ package Devel::Cover::Report::Text;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
-use Devel::Cover::DB 0.38;
+use Devel::Cover::DB 0.39;
sub print_file
{
@@ -261,7 +261,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
6 lib/Devel/Cover/Report/Text2.pm
@@ -2,9 +2,9 @@ package Devel::Cover::Report::Text2;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
-use Devel::Cover::DB 0.38;
+use Devel::Cover::DB 0.39;
use Devel::Cover::Truth_Table;
my %format = (
@@ -191,7 +191,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
12 lib/Devel/Cover/Statement.pm
@@ -10,14 +10,14 @@ package Devel::Cover::Statement;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Criterion";
-sub covered { $_[0][0][0] }
+sub covered { ${$_[0]} }
sub total { 1 }
-sub percentage { $_[0][0][0] ? 100 : 0 }
-sub error { !$_[0][0][0] }
+sub percentage { ${$_[0]} ? 100 : 0 }
+sub error { !${$_[0]} }
sub calculate_summary
{
@@ -31,7 +31,7 @@ sub calculate_summary
$s->{Total}{statement}{total}++;
$s->{Total}{total}{total}++;
- if ($self->[0][0])
+ if ($$self)
{
$s->{$file}{statement}{covered}++;
$s->{$file}{total}{covered}++;
@@ -68,7 +68,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
14 lib/Devel/Cover/Subroutine.pm
@@ -10,15 +10,15 @@ package Devel::Cover::Subroutine;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Criterion";
-sub covered { $_[0][0][0] }
+sub covered { $_[0][0] }
sub total { 1 }
-sub percentage { $_[0][0][0] ? 100 : 0 }
-sub error { !$_[0][0][0] }
-sub name { $_[0][0][1] }
+sub percentage { $_[0][0] ? 100 : 0 }
+sub error { !$_[0][0] }
+sub name { $_[0][1] }
sub calculate_summary
{
@@ -32,7 +32,7 @@ sub calculate_summary
$s->{Total}{subroutine}{total}++;
$s->{Total}{total}{total}++;
- if ($self->[0][0])
+ if ($self->[0])
{
$s->{$file}{subroutine}{covered}++;
$s->{$file}{total}{covered}++;
@@ -69,7 +69,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
17 lib/Devel/Cover/Test.pm
@@ -10,14 +10,14 @@ package Devel::Cover::Test;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use Carp;
use File::Spec;
use Test;
-use Devel::Cover::Inc 0.38;
+use Devel::Cover::Inc 0.39;
sub new
{
@@ -33,8 +33,9 @@ sub new
my $self =
{
- test => $test,
- criteria => $criteria,
+ test => $test,
+ criteria => $criteria,
+ skip => "",
%params
};
@@ -59,6 +60,8 @@ sub get_params
. " -merge 0 -coverage $self->{criteria}";
$self->{cover_parameters} = join(" ", map "-coverage $_", split " ", $self->{criteria})
. " -report text";
+ $self->{skip} = $self->{skip_reason}
+ if exists $self->{skip_test} && eval $self->{skip_test};
$self
}
@@ -169,11 +172,11 @@ sub run_test
eval "use Test::Differences";
my $differences = $INC{"Test/Differences.pm"};
- my $skip = "";
- if ($self->{criteria} =~ /\bpod\b/)
+ my $skip = $self->{skip};
+ if (!$skip && $self->{criteria} =~ /\bpod\b/)
{
eval "use Pod::Coverage";
- $skip .= $INC{"Pod/Coverage.pm"} ? "" : "Pod::Coverage unavailable";
+ $skip = $INC{"Pod/Coverage.pm"} ? "" : "Pod::Coverage unavailable";
}
plan tests => ($differences || $skip) ? 1 : scalar @cover;
View
12 lib/Devel/Cover/Time.pm
@@ -10,13 +10,13 @@ package Devel::Cover::Time;
use strict;
use warnings;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
use base "Devel::Cover::Criterion";
-sub covered { $_[0][0][0] }
+sub covered { ${$_[0]} }
sub total { 1 }
-sub percentage { $_[0][0][0] ? 100 : 0 }
+sub percentage { ${$_[0]} ? 100 : 0 }
sub error { 0 }
sub calculate_summary
@@ -24,8 +24,8 @@ sub calculate_summary
my $self = shift;
my ($db, $file) = @_;
- $db->{summary}{$file}{time}{total} += $self->[0][0];
- $db->{summary}{Total}{time}{total} += $self->[0][0];
+ $db->{summary}{$file}{time}{total} += $$self;
+ $db->{summary}{Total}{time}{total} += $$self;
}
sub calculate_percentage
@@ -70,7 +70,7 @@ Huh?
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
4 lib/Devel/Cover/Truth_Table.pm
@@ -173,7 +173,7 @@ sub covered {
package Devel::Cover::Truth_Table;
use warnings;
use strict;
-our $VERSION = "0.38";
+our $VERSION = "0.39";
#-------------------------------------------------------------------------------
# Subroutine : new()
@@ -556,7 +556,7 @@ None that I'm aware of...
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENSE
View
2  lib/Devel/Cover/Tutorial.pod
@@ -163,7 +163,7 @@ basis for future research.
=head1 VERSION
-Version 0.38 - 12th March 2004
+Version 0.39 - 22nd March 2004
=head1 LICENCE
View
2  test_output/cover/alias.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/alias1.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/branch_return_sub.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/cond_and.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/cond_branch.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/cond_or.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/cond_xor.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/default_param.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/destroy.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/dynamic_subs.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/eval1.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
37 test_output/cover/fork.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
@@ -21,20 +21,23 @@ line err stmt branch cond sub code
7 # The latest version of this software should be available from my homepage:
8 # http://www.pjcj.net
9
-10 2 $x = 1;
-11
-12 *** 2 50 die unless defined ($pid = fork);
-13
-14 2 100 if ($pid)
-15 {
-16 1 $x = 2;
-17 }
-18 else
-19 {
-20 1 $x = 3;
-21 }
-22
-23 2 print "$x: $$\n";
+10 # __COVER__ skip_test $^O eq "MSWin32"
+11 # __COVER__ skip_reason Fork unreliable
+12
+13 2 $x = 1;
+14
+15 *** 2 50 die unless defined ($pid = fork);
+16
+17 2 100 if ($pid)
+18 {
+19 1 $x = 2;
+20 }
+21 else
+22 {
+23 1 $x = 3;
+24 }
+25
+26 2 print "$x: $$\n";
Branches
@@ -42,7 +45,7 @@ Branches
line err % true false branch
----- --- ------ ------ ------ ------
-12 *** 50 0 2 unless defined($pid = fork)
-14 100 1 1 if ($pid) { }
+15 *** 50 0 2 unless defined($pid = fork)
+17 100 1 1 if ($pid) { }
View
2  test_output/cover/if.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/module1.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/module2.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/module_import.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
2  test_output/cover/overloaded.5.006001
@@ -1,4 +1,4 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
------------------------------------------ ------ ------ ------ ------ ------
View
45 test_output/cover/pod.5.006001
@@ -1,11 +1,10 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3702/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
--------------------------------------------------------------- ------ ------
File pod total
--------------------------------------------------------------- ------ ------
tests/Module1.pm 50.0 50.0
-tests/pod n/a n/a
Total 50.0 50.0
--------------------------------------------------------------- ------ ------