Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

import Devel::Cover 0.45

  • Loading branch information...
commit b768db32b22959413639aea00b999a3d1134bf2a 1 parent fd354c7
@pjcj authored
Showing with 662 additions and 347 deletions.
  1. +6 −0 CHANGES
  2. +2 −3 Cover.xs
  3. +3 −0  MANIFEST
  4. +1 −1  META.yml
  5. +14 −9 Makefile.PL
  6. +18 −10 cover
  7. +5 −5 cpancover
  8. +2 −2 create_gold
  9. +3 −3 gcov2perl
  10. +30 −13 lib/Devel/Cover.pm
  11. +15 −7 lib/Devel/Cover/Branch.pm
  12. +19 −11 lib/Devel/Cover/Condition.pm
  13. +2 −2 lib/Devel/Cover/Condition_and_3.pm
  14. +2 −2 lib/Devel/Cover/Condition_or_2.pm
  15. +2 −2 lib/Devel/Cover/Condition_or_3.pm
  16. +2 −2 lib/Devel/Cover/Condition_xor_4.pm
  17. +13 −13 lib/Devel/Cover/Criterion.pm
  18. +71 −14 lib/Devel/Cover/DB.pm
  19. +3 −3 lib/Devel/Cover/DB/File.pm
  20. +2 −2 lib/Devel/Cover/DB/Structure.pm
  21. +2 −2 lib/Devel/Cover/Op.pm
  22. +7 −6 lib/Devel/Cover/Pod.pm
  23. +2 −2 lib/Devel/Cover/Report/Html.pm
  24. +5 −5 lib/Devel/Cover/Report/Html_basic.pm
  25. +5 −5 lib/Devel/Cover/Report/Html_minimal.pm
  26. +6 −6 lib/Devel/Cover/Report/Html_subtle.pm
  27. +3 −3 lib/Devel/Cover/Report/Text.pm
  28. +3 −3 lib/Devel/Cover/Report/Text2.pm
  29. +9 −7 lib/Devel/Cover/Statement.pm
  30. +8 −7 lib/Devel/Cover/Subroutine.pm
  31. +23 −17 lib/Devel/Cover/Test.pm
  32. +2 −2 lib/Devel/Cover/Time.pm
  33. +2 −2 lib/Devel/Cover/Truth_Table.pm
  34. +1 −1  lib/Devel/Cover/Tutorial.pod
  35. +87 −56 test_output/cover/cond_or.5.006001
  36. +85 −55 test_output/cover/cond_or.5.008
  37. +85 −55 test_output/cover/cond_or.5.008001
  38. +64 −0 test_output/cover/uncoverable.5.006001
  39. +7 −0 tests/.uncoverable
  40. +17 −7 tests/cond_or
  41. +2 −2 tests/md5.t
  42. +22 −0 tests/uncoverable
View
6 CHANGES
@@ -298,3 +298,9 @@ Release 0.44 - 18th May 2004
- Fix up gcov2perl.
- Fail gracefully when covering a threaded program.
- Add DEVEL_COVER_OPTIONS environment variable.
+
+Release 0.45 - 27th May 2004
+ - Cope with spaces in build path on Windows (Max Maischein).
+ - Allow Devel::Cover to be used under mod_perl (Philippe M. Chiasson).
+ - Handle $x ||= 1 and friends nicely, including subs and *foo{THING}.
+ - Allow uncoverable code to be specified. (Unfinished)
View
5 Cover.xs
@@ -176,7 +176,7 @@ static void set_firsts_if_neeed()
SV *init = (SV *)get_cv("Devel::Cover::first_init", 0);
SV *end = (SV *)get_cv("Devel::Cover::first_end", 0);
NDEB(svdump(end));
- if (av_len(PL_initav) >= 0)
+ if (PL_initav && av_len(PL_initav) >= 0)
{
SV **cv = av_fetch(PL_initav, 0, 0);
if (*cv != init)
@@ -185,7 +185,7 @@ static void set_firsts_if_neeed()
av_store(PL_initav, 0, init);
}
}
- if (av_len(PL_endav) >= 0)
+ if (PL_endav && av_len(PL_endav) >= 0)
{
SV **cv = av_fetch(PL_endav, 0, 0);
if (*cv != end)
@@ -396,7 +396,6 @@ static void cover_logop() {
if (right->op_type == OP_NEXT ||
right->op_type == OP_LAST ||
right->op_type == OP_REDO ||
- right->op_type == OP_REDO ||
right->op_type == OP_GOTO ||
right->op_type == OP_RETURN)
{
View
3  MANIFEST
@@ -64,6 +64,8 @@ tests/t0
tests/t1
tests/t2
tests/trivial
+tests/uncoverable
+tests/.uncoverable
tests/Alias1.pm
tests/Module1.pm
tests/Module2.pm
@@ -136,3 +138,4 @@ test_output/cover/t2.5.008
test_output/cover/t2.5.008001
test_output/cover/trivial.5.006001
test_output/cover/trivial.5.008
+test_output/cover/uncoverable.5.006001
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.44
+version: 0.45
version_from:
installdirs: site
requires:
View
23 Makefile.PL
@@ -19,8 +19,8 @@ use File::Copy;
$| = 1;
-my $Version = "0.44";
-my $Date = "18th May 2004";
+my $Version = "0.45";
+my $Date = "27th May 2004";
my $Author = 'pjcj@cpan.org';
my @perlbug = ("perlbug", "-a", $Author,
@@ -32,7 +32,8 @@ my @versions = grep { $_ ne "README" && $_ ne "Makefile.PL" } @files;
my $base = getcwd;
-my %inc = map { ($_ eq "." ? $_ : Cwd::abs_path($_)) => 1 } @INC;
+my %inc = map { -d $_ ? (($_ eq "." ? $_ : Cwd::abs_path($_)) => 1) : () }
+ @INC;
my @inc = sort keys %inc;
open I, ">lib/Devel/Cover/Inc.pm"
@@ -72,7 +73,7 @@ opendir D, "tests" or die "Cannot opendir tests: $!";
for my $t (readdir D)
{
next unless -f "tests/$t";
- next if $t =~ /\.(pm|pl|version|org|bak)$/;
+ next if $t =~ /\.(pm|pl|version|org|bak|uncoverable)$/;
next if $t =~ /~$/;
if ($t =~ /\.t/)
@@ -354,12 +355,16 @@ COVER_OPTIONS =
_run : pure_all
\t \$(PERL) \$(TAINT) -Iblib/lib -Iblib/arch -MDevel::Cover=-merge,0,`\$(PERL) -e 'qx|grep __COVER__ \$\$ARGV[0]| =~ /__COVER__\\s+criteria\\s+(.*)/; (\$\$c = \$\$1 || "all") =~ s/\\s+/,/g; print "-coverage,\$\$c"' tests/\$(TEST)`,\$(COVER_OPTIONS) tests/\$(TEST)
+UNCOVERABLE = \$(PERL) -e 'print "-uncoverable \$\$1 " if qx|grep __COVER__ \$\$ARGV[0]| =~ /__COVER__\\s+uncoverable\\s+(.*)/' tests/\$(TEST)
+
html : _run
-\t \$(PERL) -Mblib cover
+\t \$(PERL) -Mblib cover `\$(UNCOVERABLE)` -report html
+
+_out : _run
+\t \$(PERL) -Mblib cover `\$(UNCOVERABLE)` -report text > \$(TEST).out
-text : html
-\t \$(PERL) -Mblib cover -report text > \$(TEST).out && \\
- gvim -d \$(TEST).out
+text : _out
+\t gvim -d \$(TEST).out
wrun : pure_all
\t \$(PERL) \$(TAINT) -Iblib/lib -Iblib/arch -MDevel::Cover=-ignore,blib,-merge,0 tests/\$(TEST)
@@ -373,7 +378,7 @@ FONT = 8x13
FONT = -sun-screen-medium-r-normal-*-*-70-*-*-m-*-sun-fontspecific
FONT = "Bitstream Vera Sans Mono 8"
-diff : _run
+diff : _out
\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
View
28 cover
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
-use Devel::Cover::DB 0.44;
+use Devel::Cover::DB 0.45;
use Cwd "abs_path";
use Data::Dumper;
@@ -24,12 +24,13 @@ use Pod::Usage;
my $Options =
{
- coverage => [],
- delete => 0,
- exclude => [],
- file => [],
- report => "",
- summary => 1,
+ coverage => [],
+ delete => 0,
+ exclude => [],
+ file => [],
+ report => "",
+ summary => 1,
+ uncoverable => [],
};
sub get_options
@@ -54,6 +55,7 @@ sub get_options
report=s
silent!
summary!
+ uncoverable=s
version|v!
));
Getopt::Long::Configure("nopass_through");
@@ -118,7 +120,11 @@ sub main
}
print "Reading database from $dbname\n" unless $Options->{silent};
- my $db = Devel::Cover::DB->new(db => $dbname);
+ my $db = Devel::Cover::DB->new
+ (
+ db => $dbname,
+ uncoverable => $Options->{uncoverable},
+ );
$db = $db->merge_runs;
for my $merge (@ARGV)
@@ -159,6 +165,8 @@ sub main
return unless length $Options->{report};
+ # use Data::Dumper; $Data::Dumper::Indent = 1; print Dumper $db->cover;
+
my %f = map { $_ => 1 } (@{$Options->{file}}
? map glob, @{$Options->{file}}
: $db->cover->items);
@@ -258,7 +266,7 @@ See the BUGS file.
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
10 cpancover
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
-use Devel::Cover::DB 0.44;
+use Devel::Cover::DB 0.45;
use Cwd ();
use File::Find ();
@@ -309,7 +309,7 @@ package Devel::Cover::Cpancover::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use base "Template::Provider";
@@ -345,7 +345,7 @@ $Templates{html} = <<'EOT';
<!--
-This file was generated by Devel::Cover Version 0.44
+This file was generated by Devel::Cover Version 0.45
Devel::Cover is copyright 2001-2004, Paul Johnson (pjcj@cpan.org)
@@ -455,7 +455,7 @@ The following exit values are returned:
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
4 create_gold
@@ -12,11 +12,11 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use blib;
-use Devel::Cover::Test 0.44;
+use Devel::Cover::Test 0.45;
my @tests = @ARGV;
View
6 gcov2perl
@@ -12,9 +12,9 @@ require 5.6.1;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
-use Devel::Cover::DB 0.44;
+use Devel::Cover::DB 0.45;
use Getopt::Long;
use Pod::Usage;
@@ -135,7 +135,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
43 lib/Devel/Cover.pm
@@ -10,13 +10,13 @@ package Devel::Cover;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use DynaLoader ();
our @ISA = "DynaLoader";
-use Devel::Cover::DB 0.44;
-use Devel::Cover::Inc 0.44;
+use Devel::Cover::DB 0.45;
+use Devel::Cover::Inc 0.45;
use B qw( class ppname main_cv main_start main_root walksymtable OPf_KIDS );
use B::Debug;
@@ -29,7 +29,8 @@ BEGIN { eval "use Pod::Coverage 0.06" } # We'll use this if it is available.
my $Initialised; # import() has been called.
-my $Dir; # Directory in cover will be gathered.
+my $Dir; # Directory in which coverage will be
+ # collected.
my $DB = "cover_db"; # DB name.
my $Merge = 1; # Merge databases.
my $Summary = 1; # Output coverage summary.
@@ -77,13 +78,9 @@ BEGIN
BEGIN { @Inc = @Devel::Cover::Inc::Inc; @Ignore = ("/Devel/Cover[./]") }
# BEGIN { $^P = 0x004 | 0x010 | 0x100 | 0x200 }
BEGIN { $^P = 0x004 | 0x100 | 0x200 }
-# BEGIN { $^P = 0x004 | 0x100 }
{
-
- no warnings "void"; # Avoid "Too late to run CHECK block" warning.
-
- CHECK
+ sub check
{
return unless $Initialised;
@@ -112,6 +109,7 @@ EOM
@coverage ? " and " : "",
"$last.\n",
$nopod,
+ $ENV{MOD_PERL} ? " Collecting under $ENV{MOD_PERL}\n" : "",
"Selecting packages matching:", join("\n ", "", @Select), "\n",
"Ignoring packages matching:", join("\n ", "", @Ignore), "\n",
"Ignoring packages in:", join("\n ", "", @Inc), "\n"
@@ -123,6 +121,8 @@ EOM
$Run{start} = get_elapsed();
}
+ no warnings "void"; # Avoid "Too late to run CHECK block" warning.
+ CHECK { check }
}
{
@@ -234,6 +234,12 @@ sub import
%Coverage = (all => 1) unless keys %Coverage;
$Initialised = 1;
+
+ if ($ENV{MOD_PERL})
+ {
+ check();
+ set_first_init_and_end();
+ }
}
sub cover_names_to_val
@@ -638,8 +644,10 @@ sub add_condition_cover
if ($type eq "or")
{
- my $name = $op->first->sibling->name;
- if ($name eq "const" || $name eq "srefgen")
+ my $r = $op->first->sibling;
+ my $name = $r->name;
+ $name = $r->first->name if $name eq "sassign";
+ if ($name =~ /^const|s?refgen|gelem$/)
{
$c = [ $c->[3], $c->[1] + $c->[2] ];
$count = 2;
@@ -776,6 +784,7 @@ sub B::Deparse::deparse
}
my $d = eval { $original_deparse->($self, @_) };
+ $d =~ s/^\010+//mg if defined $d;
$@ ? "Deparse error: $@" : $d
}
@@ -836,7 +845,7 @@ sub B::Deparse::logassignop
sub get_cover
{
- my $deparse = B::Deparse->new("-l");
+ my $deparse = B::Deparse->new;
my $cv = $deparse->{curcv} = shift;
@@ -1100,6 +1109,14 @@ Modules used by Devel::Cover while gathering coverage:
=back
+=head2 mod_perl
+
+By adding C<use Devel::Cover;> to your mod_perl startup script, you
+should be able to collect coverage information when running under
+mod_perl. You can also add any options you need at this point. I would
+suggest adding this as early as possible in your startup script in order
+to collect as much coverage information as possible.
+
=head1 BUGS
Did I mention that this is alpha code?
@@ -1108,7 +1125,7 @@ See the BUGS file. And the TODO file.
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
22 lib/Devel/Cover/Branch.pm
@@ -10,20 +10,28 @@ package Devel::Cover::Branch;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Criterion";
-sub covered { (scalar grep $_, @{$_[0][0]}) }
-sub total { (scalar @{$_[0][0]}) }
+sub uncoverable { $_[0][2][shift] }
+sub covered { (scalar grep $_, @{$_[0][0]}) }
+sub total { (scalar @{$_[0][0]}) }
sub percentage
{
my $t = $_[0]->total;
sprintf "%3d", $t ? $_[0]->covered / $t * 100 : 0
}
-sub error { scalar grep !$_, @{$_[0][0]} }
-sub text { $_[0][1]{text} }
-sub values { @{$_[0][0]} }
+sub error
+{
+ for (0 .. $#{$_[0][0]})
+ {
+ return 1 if $_[0][0][$_] xor !$_[0][2][$_]
+ }
+ 0
+}
+sub text { $_[0][1]{text} }
+sub values { @{$_[0][0]} }
sub calculate_summary
{
@@ -76,7 +84,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
30 lib/Devel/Cover/Condition.pm
@@ -10,24 +10,32 @@ package Devel::Cover::Condition;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Criterion";
-sub covered { (scalar grep $_, @{$_[0][0]}) }
-sub total { (scalar @{$_[0][0]}) }
+sub uncoverable { $_[0][2][shift] }
+sub covered { (scalar grep $_, @{$_[0][0]}) }
+sub total { (scalar @{$_[0][0]}) }
sub percentage
{
my $t = $_[0]->total;
sprintf "%3d", $t ? $_[0]->covered / $t * 100 : 0
}
-sub error { scalar grep !$_, @{$_[0][0]} }
-sub text { "$_[0][1]{left} $_[0][1]{op} $_[0][1]{right}" }
-sub type { $_[0][1]{type} }
-sub pad { $_[0][0][$_] ||= 0 for 0 .. $_[0]->count - 1 }
-sub values { $_[0]->pad; @{$_[0][0]} }
-sub count { require Carp; Carp::confess "count() must be overridden" }
-sub headers { require Carp; Carp::confess "headers() must be overridden" }
+sub error
+{
+ for (0 .. $#{$_[0][0]})
+ {
+ return 1 if $_[0][0][$_] xor !$_[0][2][$_]
+ }
+ 0
+}
+sub text { "$_[0][1]{left} $_[0][1]{op} $_[0][1]{right}" }
+sub type { $_[0][1]{type} }
+sub pad { $_[0][0][$_] ||= 0 for 0 .. $_[0]->count - 1 }
+sub values { $_[0]->pad; @{$_[0][0]} }
+sub count { require Carp; Carp::confess "count() must be overridden" }
+sub headers { require Carp; Carp::confess "headers() must be overridden" }
sub calculate_summary
{
@@ -80,7 +88,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 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.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 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.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 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.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Condition";
@@ -46,7 +46,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 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.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Condition";
@@ -45,7 +45,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
26 lib/Devel/Cover/Criterion.pm
@@ -10,18 +10,18 @@ package Devel::Cover::Criterion;
use strict;
use warnings;
-our $VERSION = "0.44";
-
-use Devel::Cover::Statement 0.44;
-use Devel::Cover::Branch 0.44;
-use Devel::Cover::Condition 0.44;
-use Devel::Cover::Condition_or_2 0.44;
-use Devel::Cover::Condition_or_3 0.44;
-use Devel::Cover::Condition_and_3 0.44;
-use Devel::Cover::Condition_xor_4 0.44;
-use Devel::Cover::Subroutine 0.44;
-use Devel::Cover::Time 0.44;
-use Devel::Cover::Pod 0.44;
+our $VERSION = "0.45";
+
+use Devel::Cover::Statement 0.45;
+use Devel::Cover::Branch 0.45;
+use Devel::Cover::Condition 0.45;
+use Devel::Cover::Condition_or_2 0.45;
+use Devel::Cover::Condition_or_3 0.45;
+use Devel::Cover::Condition_and_3 0.45;
+use Devel::Cover::Condition_xor_4 0.45;
+use Devel::Cover::Subroutine 0.45;
+use Devel::Cover::Time 0.45;
+use Devel::Cover::Pod 0.45;
sub coverage { $_[0][0] }
sub information { $_[0][1] }
@@ -71,7 +71,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
85 lib/Devel/Cover/DB.pm
@@ -10,17 +10,17 @@ package Devel::Cover::DB;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
-use Devel::Cover::Criterion 0.44;
-use Devel::Cover::DB::File 0.44;
-use Devel::Cover::DB::Structure 0.44;
+use Devel::Cover::Criterion 0.45;
+use Devel::Cover::DB::File 0.45;
+use Devel::Cover::DB::Structure 0.45;
use Carp;
use File::Path;
use Storable;
-my $DB = "cover.10"; # Version 10 of the database.
+my $DB = "cover.11"; # Version 11 of the database.
sub new
{
@@ -33,6 +33,7 @@ sub new
[ qw( stmt branch path cond sub pod time ) ],
runs => {},
collected => {},
+ uncoverable => [],
@_
};
@@ -360,6 +361,29 @@ sub print_summary
sub add_statement
{
my $self = shift;
+ my ($cc, $sc, $fc, $uc) = @_;
+ my %line;
+ for my $i (0 .. $#$fc)
+ {
+ my $l = $sc->[$i];
+ unless (defined $l)
+ {
+ # use Data::Dumper;
+ # print STDERR "sc ", scalar @$sc, ", fc ", scalar @$fc, "\n";
+ # print STDERR "sc ", Dumper($sc), "fc ", Dumper($fc);
+ warn "Devel::Cover: ignoring extra statement\n";
+ return;
+ }
+ my $n = $line{$l}++;
+ no warnings "uninitialized";
+ $cc->{$l}[$n][0] += $fc->[$i];
+ $cc->{$l}[$n][1] ||= $uc->{$l}[$n][0][1];
+ }
+}
+
+sub add_time
+{
+ my $self = shift;
my ($cc, $sc, $fc) = @_;
my %line;
for my $i (0 .. $#$fc)
@@ -383,7 +407,7 @@ sub add_statement
sub add_branch
{
my $self = shift;
- my ($cc, $sc, $fc) = @_;
+ my ($cc, $sc, $fc, $uc) = @_;
my %line;
for my $i (0 .. $#$fc)
{
@@ -406,13 +430,14 @@ sub add_branch
{
$cc->{$l}[$n] = [ $fc->[$i], $sc->[$i][1] ];
}
+ $cc->{$l}[$n][2][$_->[0]] ||= $_->[1] for @{$uc->{$l}[$n]};
}
}
sub add_subroutine
{
my $self = shift;
- my ($cc, $sc, $fc) = @_;
+ my ($cc, $sc, $fc, $uc) = @_;
my %line;
for my $i (0 .. $#$fc)
{
@@ -435,12 +460,36 @@ sub add_subroutine
{
$cc->{$l}[$n] = [ $fc->[$i], $sc->[$i][1] ];
}
+ $cc->{$l}[$n][2] ||= $uc->{$l}[$n][0][1];
}
}
-*add_condition = \&add_branch;
-*add_pod = \&add_subroutine;
-*add_time = \&add_statement;
+*add_condition = \&add_branch;
+*add_pod = \&add_subroutine;
+
+sub uncoverable
+{
+ my $self = shift;
+
+ my $u = {};
+
+ my $f = ".uncoverable";
+ for my $file ($f, glob("~/$f"), @{$self->{uncoverable}})
+ {
+ open F, $file or next;
+ print STDERR "Devel::Cover: reading uncoverable information ",
+ "from $file\n"
+ unless $Devel::Cover::Silent;
+ while (<F>)
+ {
+ chomp;
+ my ($md5, $crit, $line, $count, $type, $reason) = split " ", $_, 6;
+ push @{$u->{$md5}{$crit}{$line}[$count]}, [$type, $reason];
+ }
+ }
+
+ $u
+}
sub cover
{
@@ -451,6 +500,8 @@ sub cover
my %digests;
my %files;
my $cover = $self->{cover} = {};
+ my $uncoverable = $self->uncoverable;
+
while (my ($run, $r) = each %{$self->{runs}})
{
@{$self->{collected}}{@{$r->{collected}}} = ();
@@ -474,7 +525,10 @@ sub cover
digest => $digest,
);
# print "Structure from $st->{file}\n";
- # use Data::Dumper; print STDERR "st ", Dumper($st), "f ", Dumper($f);
+ # use Data::Dumper;
+ # print STDERR "st ", Dumper($st),
+ # "f ", Dumper($f),
+ # "uc ", Dumper($uncoverable->{$digest});
while (my ($criterion, $fc) = each %$f)
{
my $get = "get_$criterion";
@@ -482,7 +536,11 @@ sub cover
next unless $sc;
my $cc = $cf->{$criterion} ||= {};
my $add = "add_$criterion";
- $self->$add($cc, $sc, $fc);
+ $self->$add($cc, $sc, $fc, $uncoverable->{$digest}{$criterion});
+ # $cc - coverage being filled in
+ # $sc - structure information
+ # $fc - coverage from this file
+ # $uc - uncoverable information
}
}
}
@@ -572,7 +630,6 @@ sub cover
}
$self->{cover_valid} = 1;
-
$self->{cover}
}
@@ -655,7 +712,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
6 lib/Devel/Cover/DB/File.pm
@@ -10,9 +10,9 @@ package Devel::Cover::DB::File;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
-use Devel::Cover::Criterion 0.44;
+use Devel::Cover::Criterion 0.45;
sub calculate_summary
{
@@ -77,7 +77,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
4 lib/Devel/Cover/DB/Structure.pm
@@ -14,7 +14,7 @@ use Carp;
use Digest::MD5;
use Storable;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
our $AUTOLOAD;
sub new
@@ -150,7 +150,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
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.44";
+our $VERSION = "0.45";
use Devel::Cover qw( -ignore blib -ignore \\wB\\w );
use B::Concise qw( set_style add_callback );
@@ -112,7 +112,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
13 lib/Devel/Cover/Pod.pm
@@ -10,16 +10,17 @@ package Devel::Cover::Pod;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Criterion";
BEGIN { eval "use Pod::Coverage 0.06" } # We'll use this if it is available.
-sub covered { $_[0][0] ? 1 : 0 }
-sub total { 1 }
-sub percentage { $_[0][0] ? 100 : 0 }
-sub error { !$_[0][0] }
+sub uncoverable { $_[0][2] }
+sub covered { $_[0][0] ? 1 : 0 }
+sub total { 1 }
+sub percentage { $_[0][0] ? 100 : 0 }
+sub error { $_[0][0] xor !$_[0][2] }
sub calculate_summary
{
@@ -72,7 +73,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 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.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Report::Html_minimal";
@@ -45,7 +45,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 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.44";
+our $VERSION = "0.45";
-use Devel::Cover::DB 0.44;
+use Devel::Cover::DB 0.45;
use Template 2.00;
@@ -278,7 +278,7 @@ package Devel::Cover::Report::Html_basic::Template::Provider;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use base "Template::Provider";
@@ -314,7 +314,7 @@ $Templates{html} = <<'EOT';
<!--
-This file was generated by Devel::Cover Version 0.44
+This file was generated by Devel::Cover Version 0.45
Devel::Cover is copyright 2001-2002, Paul Johnson (pjcj@cpan.org)
@@ -533,7 +533,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
10 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.44;
-use Devel::Cover::Truth_Table 0.44;
+use Devel::Cover::DB 0.45;
+use Devel::Cover::Truth_Table 0.45;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
#-------------------------------------------------------------------------------
# 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.44
+This file was generated by Devel::Cover Version 0.45
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:
@@ -759,7 +759,7 @@ Devel::Cover
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 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.44";
+our $VERSION = "0.45";
-use Devel::Cover::DB 0.44;
-use Devel::Cover::Truth_Table 0.44;
+use Devel::Cover::DB 0.45;
+use Devel::Cover::Truth_Table 0.45;
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.44";
+our $VERSION = "0.45";
use base "Template::Provider";
@@ -404,7 +404,7 @@ sub fetch {
$Templates{html} = <<'EOT';
<!--
-This file was generated by Devel::Cover Version 0.44
+This file was generated by Devel::Cover Version 0.45
Devel::Cover is copyright 2001-2002, Paul Johnson (pjcj@cpan.org)
@@ -734,7 +734,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 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.44";
+our $VERSION = "0.45";
-use Devel::Cover::DB 0.44;
+use Devel::Cover::DB 0.45;
sub print_file
{
@@ -261,7 +261,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 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.44";
+our $VERSION = "0.45";
-use Devel::Cover::DB 0.44;
+use Devel::Cover::DB 0.45;
use Devel::Cover::Truth_Table;
my %format = (
@@ -191,7 +191,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
16 lib/Devel/Cover/Statement.pm
@@ -10,14 +10,16 @@ package Devel::Cover::Statement;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Criterion";
-sub covered { ${$_[0]} }
-sub total { 1 }
-sub percentage { ${$_[0]} ? 100 : 0 }
-sub error { !${$_[0]} }
+sub val { $_[0][0] }
+sub uncoverable { $_[0][1] }
+sub covered { $_[0][0] }
+sub total { 1 }
+sub percentage { $_[0][0] ? 100 : 0 }
+sub error { $_[0][0] xor !$_[0][1] }
sub calculate_summary
{
@@ -31,7 +33,7 @@ sub calculate_summary
$s->{Total}{statement}{total}++;
$s->{Total}{total}{total}++;
- if ($$self)
+ if ($self->[0])
{
$s->{$file}{statement}{covered}++;
$s->{$file}{total}{covered}++;
@@ -68,7 +70,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
15 lib/Devel/Cover/Subroutine.pm
@@ -10,15 +10,16 @@ package Devel::Cover::Subroutine;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Criterion";
-sub covered { $_[0][0] }
-sub total { 1 }
-sub percentage { $_[0][0] ? 100 : 0 }
-sub error { !$_[0][0] }
-sub name { $_[0][1] }
+sub uncoverable { $_[0][2] }
+sub covered { $_[0][0] }
+sub total { 1 }
+sub percentage { $_[0][0] ? 100 : 0 }
+sub error { $_[0][0] xor !$_[0][2] }
+sub name { $_[0][1] }
sub calculate_summary
{
@@ -69,7 +70,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
40 lib/Devel/Cover/Test.pm
@@ -10,14 +10,14 @@ package Devel::Cover::Test;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use Carp;
use File::Spec;
use Test;
-use Devel::Cover::Inc 0.44;
+use Devel::Cover::Inc 0.45;
sub new
{
@@ -31,11 +31,12 @@ sub new
my $criteria = delete $params{criteria} ||
"statement branch condition subroutine";
- my $self =
+ my $self =
{
- test => $test,
- criteria => $criteria,
- skip => "",
+ test => $test,
+ criteria => $criteria,
+ skip => "",
+ uncoverable => "",
%params
};
@@ -58,25 +59,33 @@ sub get_params
$self->{test_parameters} = "-select $self->{test} -ignore blib Devel/Cover"
. " -merge 0 -coverage $self->{criteria}";
- $self->{cover_parameters} = join(" ", map "-coverage $_", split " ", $self->{criteria})
+ $self->{cover_parameters} = join(" ", map "-coverage $_",
+ split " ", $self->{criteria})
. " -report text";
+ $self->{cover_parameters} .= " -uncoverable $self->{uncoverable}"
+ if $self->{uncoverable};
$self->{skip} = $self->{skip_reason}
if exists $self->{skip_test} && eval $self->{skip_test};
$self
}
+sub shell_quote
+{
+ my ($item) = @_;
+ # properly quote the item
+ $^O eq "MSWin32" ? (/ / and $_ = qq("$_")) : s/ /\\ /g for $item;
+ $item
+};
+
sub perl
{
my $self = shift;
- my $perl = $Devel::Cover::Inc::Perl;
+ my $perl = shell_quote $Devel::Cover::Inc::Perl;
my $base = $Devel::Cover::Inc::Base;
- $perl =~ s/ /\\ /g;
- $base =~ s/ /\\ /g;
-
- $perl .= " -I$base/$_" for "", "blib/lib", "blib/arch";
+ $perl .= " " . shell_quote "-I$base/$_" for "", "blib/lib", "blib/arch";
$perl
}
@@ -91,9 +100,7 @@ sub test_command
$c .= " -MDevel::Cover=" .
join(",", split ' ', $self->{test_parameters})
}
- my $t = $self->test_file;
- $t =~ s/ /\\ /g;
- $c .= " $t";
+ $c .= " " . shell_quote $self->test_file;
$c
}
@@ -102,8 +109,7 @@ sub cover_command
{
my $self = shift;
- my $b = $Devel::Cover::Inc::Base;
- $b =~ s/ /\\ /g;
+ my $b = shell_quote $Devel::Cover::Inc::Base;
$self->perl . " $b/cover $self->{cover_parameters}"
}
View
4 lib/Devel/Cover/Time.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Time;
use strict;
use warnings;
-our $VERSION = "0.44";
+our $VERSION = "0.45";
use base "Devel::Cover::Criterion";
@@ -70,7 +70,7 @@ Huh?
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 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.44";
+our $VERSION = "0.45";
#-------------------------------------------------------------------------------
# Subroutine : new()
@@ -556,7 +556,7 @@ None that I'm aware of...
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENSE
View
2  lib/Devel/Cover/Tutorial.pod
@@ -163,7 +163,7 @@ basis for future research.
=head1 VERSION
-Version 0.44 - 18th May 2004
+Version 0.45 - 27th May 2004
=head1 LICENCE
View
143 test_output/cover/cond_or.5.006001
@@ -1,11 +1,11 @@
-Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3805/cover_db
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3901/cover_db
------------------------------------------ ------ ------ ------ ------ ------
File stmt branch cond sub total
------------------------------------------ ------ ------ ------ ------ ------
-tests/cond_or 95.5 50.0 43.5 n/a 66.0
-Total 95.5 50.0 43.5 n/a 66.0
+tests/cond_or 93.9 50.0 65.9 0.0 74.7
+Total 93.9 50.0 65.9 0.0 74.7
------------------------------------------ ------ ------ ------ ------ ------
@@ -26,49 +26,60 @@ line err stmt branch cond sub code
12
13 1 my @x;
14
-15 1 my $y = 1;
-16 1 my $z = 0;
-17
-18 1 for (0 .. 10)
+15 1 my $y = 1;
+16 1 my $z = 0;
+17 1 $::foo = 17;
+18
+19 1 for (0 .. 10)
11
-19 {
-20 *** 11 50 $y ||
-21 $x[1]++;
-22
-23 *** 11 50 33 $y ||
-24 $x[0]++ ||
-25 $x[1]++;
-26
-27 *** 11 50 $x[2]++
-28 unless $z;
-29
-30 11 for (0 .. 2)
+20 {
+21 *** 11 50 $y ||
+22 $x[1]++;
+23
+24 *** 11 50 33 $y ||
+25 $x[0]++ ||
+26 $x[1]++;
+27
+28 *** 11 50 $x[2]++
+29 unless $z;
+30
+31 11 for (0 .. 2)
33
-31 {
-32 33 $x[3]++;
-33 }
-34
-35 *** 11 50 if ($z)
-36 {
-37 *** 0 $x[4]++;
-38 }
-39 else
-40 {
-41 11 $x[5]++;
-42 }
-43
-44 *** 11 33 my $p = $y || $z;
-45 *** 11 33 my $q = $z || $y;
-46 11 100 my $r = $_ || "qqq";
-47 11 my $s = $y | $z;
-48
-49 *** 11 33 $p ||= $y;
-50 *** 11 33 $p ||= $z;
-51 *** 11 66 $x[6] ||= $y;
-52 *** 11 33 $x[7] ||= $z;
-53 }
-54
-55 # print join(", ", @x), "\n";
+32 {
+33 33 $x[3]++;
+34 }
+35
+36 *** 11 50 if ($z)
+37 {
+38 *** 0 $x[4]++;
+39 }
+40 else
+41 {
+42 11 $x[5]++;
+43 }
+44
+45 *** 11 33 my $p = $y || $z;
+46 *** 11 33 my $q = $z || $y;
+47 11 100 my $r = $_ || "qqq";
+48 11 100 my $s = $_ || [];
+49 11 my $t = $y | $z;
+50
+51 *** 11 33 $p ||= $y;
+52 *** 11 33 $p ||= $z;
+53 *** 11 66 $x[ 6] ||= $y;
+54 *** 11 33 $x[ 7] ||= $z;
+55 11 100 $x[ 8] ||= 1;
+56 11 100 $x[ 9] ||= {};
+57 11 100 $x[10] ||= \"foo";
+58 11 100 $x[11] ||= \$y;
+59 11 100 $x[12] ||= \*STDIO;
+60 *** 11 100 0 $x[13] ||= sub { 1 };
+ *** 0
+61 11 100 $x[14] ||= *::foo{SCALAR};
+62 *** 11 50 $x[15] ||= *STDIO{IO};
+63 }
+64
+65 # print join(", ", @x), "\n";
Branches
@@ -76,10 +87,10 @@ Branches
line err % true false branch
----- --- ------ ------ ------ ------
-20 *** 50 0 11 unless $y
-23 *** 50 0 11 unless $y or $x[0]++
-27 *** 50 11 0 unless $z
-35 *** 50 0 11 if ($z) { }
+21 *** 50 0 11 unless $y
+24 *** 50 0 11 unless $y or $x[0]++
+28 *** 50 11 0 unless $z
+36 *** 50 0 11 if ($z) { }
Conditions
@@ -89,18 +100,38 @@ or 2 conditions
line err % l !l expr
----- --- ------ ------ ------ ----
-46 100 10 1 $_ || 'qqq'
+47 100 10 1 $_ || 'qqq'
+48 100 10 1 $_ || []
+55 100 10 1 $x[8] ||= 1
+56 100 10 1 $x[9] ||= {}
+57 100 10 1 $x[10] ||= \('foo')
+58 100 10 1 $x[11] ||= \$y
+59 100 10 1 $x[12] ||= \*STDIO
+60 100 10 1 $x[13] ||= sub {
+ 1;
+}
+
+61 100 10 1 $x[14] ||= *foo{'SCALAR'}
+62 *** 50 0 11 $x[15] ||= *STDIO{'IO'}
or 3 conditions
line err % l !l&&r !l&&!r expr
----- --- ------ ------ ------ ------ ----
-23 *** 33 11 0 0 $y or $x[0]++
-44 *** 33 11 0 0 $y || $z
-45 *** 33 0 11 0 $z || $y
-49 *** 33 11 0 0 $p ||= $y
-50 *** 33 11 0 0 $p ||= $z
-51 *** 66 10 1 0 $x[6] ||= $y
-52 *** 33 0 0 11 $x[7] ||= $z
+24 *** 33 11 0 0 $y or $x[0]++
+45 *** 33 11 0 0 $y || $z
+46 *** 33 0 11 0 $z || $y
+51 *** 33 11 0 0 $p ||= $y
+52 *** 33 11 0 0 $p ||= $z
+53 *** 66 10 1 0 $x[6] ||= $y
+54 *** 33 0 0 11 $x[7] ||= $z
+
+
+Uncovered Subroutines
+---------------------
+
+Subroutine Location
+---------- ----------------
+__ANON__ tests/cond_or:60
View
140 test_output/cover/cond_or.5.008
@@ -4,8 +4,8 @@ Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3901/cover_db
------------------------------------------ ------ ------ ------ ------ ------
File stmt branch cond sub total
------------------------------------------ ------ ------ ------ ------ ------
-tests/cond_or 96.4 50.0 43.5 100.0 70.5
-Total 96.4 50.0 43.5 100.0 70.5
+tests/cond_or 94.9 50.0 65.9 66.7 76.9
+Total 94.9 50.0 65.9 66.7 76.9
------------------------------------------ ------ ------ ------ ------ ------
@@ -30,49 +30,60 @@ line err stmt branch cond sub code
12
13 1 my @x;
14
-15 1 my $y = 1;
-16 1 my $z = 0;
-17
-18 1 for (0 .. 10)
+15 1 my $y = 1;
+16 1 my $z = 0;
+17 1 $::foo = 17;
+18
+19 1 for (0 .. 10)
11
-19 {
-20 *** 11 50 $y ||
-21 $x[1]++;
-22
-23 *** 11 50 33 $y ||
-24 $x[0]++ ||
-25 $x[1]++;
-26
-27 *** 11 50 $x[2]++
-28 unless $z;
-29
-30 11 for (0 .. 2)
+20 {
+21 *** 11 50 $y ||
+22 $x[1]++;
+23
+24 *** 11 50 33 $y ||
+25 $x[0]++ ||
+26 $x[1]++;
+27
+28 *** 11 50 $x[2]++
+29 unless $z;
+30
+31 11 for (0 .. 2)
33
-31 {
-32 33 $x[3]++;
-33 }
-34
-35 *** 11 50 if ($z)
-36 {
-37 *** 0 $x[4]++;
-38 }
-39 else
-40 {
-41 11 $x[5]++;
-42 }
-43
-44 *** 11 33 my $p = $y || $z;
-45 *** 11 33 my $q = $z || $y;
-46 11 100 my $r = $_ || "qqq";
-47 11 my $s = $y | $z;
-48
-49 *** 11 33 $p ||= $y;
-50 *** 11 33 $p ||= $z;
-51 *** 11 66 $x[6] ||= $y;
-52 *** 11 33 $x[7] ||= $z;
-53 }
-54
-55 # print join(", ", @x), "\n";
+32 {
+33 33 $x[3]++;
+34 }
+35
+36 *** 11 50 if ($z)
+37 {
+38 *** 0 $x[4]++;
+39 }
+40 else
+41 {
+42 11 $x[5]++;
+43 }
+44
+45 *** 11 33 my $p = $y || $z;
+46 *** 11 33 my $q = $z || $y;
+47 11 100 my $r = $_ || "qqq";
+48 11 100 my $s = $_ || [];
+49 11 my $t = $y | $z;
+50
+51 *** 11 33 $p ||= $y;
+52 *** 11 33 $p ||= $z;
+53 *** 11 66 $x[ 6] ||= $y;
+54 *** 11 33 $x[ 7] ||= $z;
+55 11 100 $x[ 8] ||= 1;
+56 11 100 $x[ 9] ||= {};
+57 11 100 $x[10] ||= \"foo";
+58 11 100 $x[11] ||= \$y;
+59 11 100 $x[12] ||= \*STDIO;
+60 *** 11 100 0 $x[13] ||= sub { 1 };
+ *** 0
+61 11 100 $x[14] ||= *::foo{SCALAR};
+62 *** 11 50 $x[15] ||= *STDIO{IO};
+63 }
+64
+65 # print join(", ", @x), "\n";
Branches
@@ -80,10 +91,10 @@ Branches
line err % true false branch
----- --- ------ ------ ------ ------
-20 *** 50 0 11 unless $y
-23 *** 50 0 11 unless $y or $x[0]++
-27 *** 50 11 0 unless $z
-35 *** 50 0 11 if ($z) { }
+21 *** 50 0 11 unless $y
+24 *** 50 0 11 unless $y or $x[0]++
+28 *** 50 11 0 unless $z
+36 *** 50 0 11 if ($z) { }
Conditions
@@ -93,19 +104,31 @@ or 2 conditions
line err % l !l expr
----- --- ------ ------ ------ ----
-46 100 10 1 $_ || 'qqq'
+47 100 10 1 $_ || 'qqq'
+48 100 10 1 $_ || []
+55 100 10 1 $x[8] ||= 1
+56 100 10 1 $x[9] ||= {}
+57 100 10 1 $x[10] ||= \('foo')
+58 100 10 1 $x[11] ||= \$y
+59 100 10 1 $x[12] ||= \*STDIO
+60 100 10 1 $x[13] ||= sub {
+ 1;
+}
+
+61 100 10 1 $x[14] ||= *foo{'SCALAR'}
+62 *** 50 0 11 $x[15] ||= *STDIO{'IO'}
or 3 conditions
line err % l !l&&r !l&&!r expr
----- --- ------ ------ ------ ------ ----
-23 *** 33 11 0 0 $y or $x[0]++
-44 *** 33 11 0 0 $y || $z
-45 *** 33 0 11 0 $z || $y
-49 *** 33 11 0 0 $p ||= $y
-50 *** 33 11 0 0 $p ||= $z
-51 *** 66 10 1 0 $x[6] ||= $y
-52 *** 33 0 0 11 $x[7] ||= $z
+24 *** 33 11 0 0 $y or $x[0]++
+45 *** 33 11 0 0 $y || $z
+46 *** 33 0 11 0 $z || $y
+51 *** 33 11 0 0 $p ||= $y
+52 *** 33 11 0 0 $p ||= $z
+53 *** 66 10 1 0 $x[6] ||= $y
+54 *** 33 0 0 11 $x[7] ||= $z
Covered Subroutines
@@ -116,4 +139,11 @@ Subroutine Location
BEGIN tests/cond_or:10
BEGIN tests/cond_or:11
+Uncovered Subroutines
+---------------------
+
+Subroutine Location
+---------- ----------------
+__ANON__ tests/cond_or:60
+
View
140 test_output/cover/cond_or.5.008001
@@ -4,8 +4,8 @@ Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3901/cover_db
------------------------------------------ ------ ------ ------ ------ ------
File stmt branch cond sub total
------------------------------------------ ------ ------ ------ ------ ------
-tests/cond_or 96.2 50.0 43.5 100.0 69.5
-Total 96.2 50.0 43.5 100.0 69.5
+tests/cond_or 94.6 50.0 65.9 66.7 76.4
+Total 94.6 50.0 65.9 66.7 76.4
------------------------------------------ ------ ------ ------ ------ ------
@@ -30,47 +30,58 @@ line err stmt branch cond sub code
12
13 1 my @x;
14
-15 1 my $y = 1;
-16 1 my $z = 0;
-17
-18 1 for (0 .. 10)
-19 {
-20 *** 11 50 $y ||
-21 $x[1]++;
-22
-23 *** 11 50 33 $y ||
-24 $x[0]++ ||
-25 $x[1]++;
-26
-27 *** 11 50 $x[2]++
-28 unless $z;
-29
-30 11 for (0 .. 2)
-31 {
-32 33 $x[3]++;
-33 }
-34
-35 *** 11 50 if ($z)
-36 {
-37 *** 0 $x[4]++;
-38 }
-39 else
-40 {
-41 11 $x[5]++;
-42 }
-43
-44 *** 11 33 my $p = $y || $z;
-45 *** 11 33 my $q = $z || $y;
-46 11 100 my $r = $_ || "qqq";
-47 11 my $s = $y | $z;
-48
-49 *** 11 33 $p ||= $y;
-50 *** 11 33 $p ||= $z;
-51 *** 11 66 $x[6] ||= $y;
-52 *** 11 33 $x[7] ||= $z;
-53 }
-54
-55 # print join(", ", @x), "\n";
+15 1 my $y = 1;
+16 1 my $z = 0;
+17 1 $::foo = 17;
+18
+19 1 for (0 .. 10)
+20 {
+21 *** 11 50 $y ||
+22 $x[1]++;
+23
+24 *** 11 50 33 $y ||
+25 $x[0]++ ||
+26 $x[1]++;
+27
+28 *** 11 50 $x[2]++
+29 unless $z;
+30
+31 11 for (0 .. 2)
+32 {
+33 33 $x[3]++;
+34 }
+35
+36 *** 11 50 if ($z)
+37 {
+38 *** 0 $x[4]++;
+39 }
+40 else
+41 {
+42 11 $x[5]++;
+43 }
+44
+45 *** 11 33 my $p = $y || $z;
+46 *** 11 33 my $q = $z || $y;
+47 11 100 my $r = $_ || "qqq";
+48 11 100 my $s = $_ || [];
+49 11 my $t = $y | $z;
+50
+51 *** 11 33 $p ||= $y;
+52 *** 11 33 $p ||= $z;
+53 *** 11 66 $x[ 6] ||= $y;
+54 *** 11 33 $x[ 7] ||= $z;
+55 11 100 $x[ 8] ||= 1;
+56 11 100 $x[ 9] ||= {};
+57 11 100 $x[10] ||= \"foo";
+58 11 100 $x[11] ||= \$y;
+59 11 100 $x[12] ||= \*STDIO;
+60 *** 11 100 0 $x[13] ||= sub { 1 };
+ *** 0
+61 11 100 $x[14] ||= *::foo{SCALAR};
+62 *** 11 50 $x[15] ||= *STDIO{IO};
+63 }
+64
+65 # print join(", ", @x), "\n";
Branches
@@ -78,10 +89,10 @@ Branches
line err % true false branch
----- --- ------ ------ ------ ------
-20 *** 50 0 11 unless $y
-23 *** 50 0 11 unless $y or $x[0]++
-27 *** 50 11 0 unless $z
-35 *** 50 0 11 if ($z) { }
+21 *** 50 0 11 unless $y
+24 *** 50 0 11 unless $y or $x[0]++
+28 *** 50 11 0 unless $z
+36 *** 50 0 11 if ($z) { }
Conditions
@@ -91,19 +102,31 @@ or 2 conditions
line err % l !l expr
----- --- ------ ------ ------ ----
-46 100 10 1 $_ || 'qqq'
+47 100 10 1 $_ || 'qqq'
+48 100 10 1 $_ || []
+55 100 10 1 $x[8] ||= 1
+56 100 10 1 $x[9] ||= {}
+57 100 10 1 $x[10] ||= \'foo'
+58 100 10 1 $x[11] ||= \$y
+59 100 10 1 $x[12] ||= \*STDIO
+60 100 10 1 $x[13] ||= sub {
+ 1;
+}
+
+61 100 10 1 $x[14] ||= *foo{'SCALAR'}
+62 *** 50 0 11 $x[15] ||= *STDIO{'IO'}
or 3 conditions
line err % l !l&&r !l&&!r expr
----- --- ------ ------ ------ ------ ----
-23 *** 33 11 0 0 $y or $x[0]++
-44 *** 33 11 0 0 $y || $z
-45 *** 33 0 11 0 $z || $y
-49 *** 33 11 0 0 $p ||= $y
-50 *** 33 11 0 0 $p ||= $z
-51 *** 66 10 1 0 $x[6] ||= $y
-52 *** 33 0 0 11 $x[7] ||= $z
+24 *** 33 11 0 0 $y or $x[0]++
+45 *** 33 11 0 0 $y || $z
+46 *** 33 0 11 0 $z || $y
+51 *** 33 11 0 0 $p ||= $y
+52 *** 33 11 0 0 $p ||= $z
+53 *** 66 10 1 0 $x[6] ||= $y
+54 *** 33 0 0 11 $x[7] ||= $z
Covered Subroutines
@@ -114,4 +137,11 @@ Subroutine Location
BEGIN tests/cond_or:10
BEGIN tests/cond_or:11
+Uncovered Subroutines
+---------------------
+
+Subroutine Location
+---------- ----------------
+__ANON__ tests/cond_or:60
+
View
64 test_output/cover/uncoverable.5.006001
@@ -0,0 +1,64 @@
+Reading database from /home/pjcj/g/perl/dev/Devel-Cover-0.3901/cover_db
+
+
+------------------------------------------ ------ ------ ------ ------ ------
+File stmt branch cond sub total
+------------------------------------------ ------ ------ ------ ------ ------
+tests/uncoverable 50.0 50.0 33.3 0.0 41.7
+Total 50.0 50.0 33.3 0.0 41.7
+------------------------------------------ ------ ------ ------ ------ ------
+
+
+tests/uncoverable
+
+line err stmt branch cond sub code
+1 #!/usr/bin/perl
+2
+3 # Copyright 2004, 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__ uncoverable tests/.uncoverable
+11
+12 1 my $x = 1;
+13 1 my $y = 1;
+14 *** 1 50 33 if ($x && !$y)
+15 {
+16 *** 0 $x++;
+17 *** 0 z();
+18 }
+19 sub z
+20 {
+21 *** 0 0 $y++;
+22 }
+
+
+Branches
+--------
+
+line err % true false branch
+----- --- ------ ------ ------ ------
+14 *** 50 0 1 if ($x and not $y)
+
+
+Conditions
+----------
+
+and 3 conditions
+
+line err % !l l&&!r l&&r expr
+----- --- ------ ------ ------ ------ ----
+14 *** 33 0 1 0 $x and not $y
+
+
+Uncovered Subroutines
+---------------------
+
+Subroutine Location
+---------- --------------------
+z tests/uncoverable:21
+
+
View
7 tests/.uncoverable
@@ -0,0 +1,7 @@
+88168fbef1dca6dd473e5a7d25303312 statement 16 0 0 Can't get to this statement
+88168fbef1dca6dd473e5a7d25303312 statement 17 0 0 Can't get to this statement
+88168fbef1dca6dd473e5a7d25303312 statement 21 0 0 Can't get to this statement
+88168fbef1dca6dd473e5a7d25303312 branch 14 0 0 Branch can't be true
+88168fbef1dca6dd473e5a7d25303312 condition 14 0 0 $x can't be false
+88168fbef1dca6dd473e5a7d25303312 condition 14 0 2 $y can't be false
+88168fbef1dca6dd473e5a7d25303312 subroutine 21 0 0 Can't run this subroutine
View
24 tests/cond_or
@@ -12,8 +12,9 @@ use warnings;
my @x;
-my $y = 1;
-my $z = 0;
+my $y = 1;
+my $z = 0;
+$::foo = 17;
for (0 .. 10)
{
@@ -44,12 +45,21 @@ for (0 .. 10)
my $p = $y || $z;
my $q = $z || $y;
my $r = $_ || "qqq";
- my $s = $y | $z;
+ my $s = $_ || [];
+ my $t = $y | $z;
- $p ||= $y;
- $p ||= $z;
- $x[6] ||= $y;
- $x[7] ||= $z;
+ $p ||= $y;
+ $p ||= $z;
+ $x[ 6] ||= $y;
+ $x[ 7] ||= $z;
+ $x[ 8] ||= 1;
+ $x[ 9] ||= {};
+ $x[10] ||= \"foo";
+ $x[11] ||= \$y;
+ $x[12] ||= \*STDIO;
+ $x[13] ||= sub { 1 };
+ $x[14] ||= *::foo{SCALAR};
+ $x[15] ||= *STDIO{IO};
}
# print join(", ", @x), "\n";
View
4 tests/md5.t
@@ -12,8 +12,8 @@ use warnings;
use File::Copy;
-use Devel::Cover::Inc 0.44;
-use Devel::Cover::Test 0.44;
+use Devel::Cover::Inc 0.45;
+use Devel::Cover::Test 0.45;
my $base = $Devel::Cover::Inc::Base;
View
22 tests/uncoverable
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+# 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
+
+# __COVER__ uncoverable tests/.uncoverable
+
+my $x = 1;
+my $y = 1;
+if ($x && !$y)
+{
+ $x++;
+ z();
+}
+sub z
+{
+ $y++;
+}

0 comments on commit b768db3

Please sign in to comment.
Something went wrong with that request. Please try again.