Skip to content
This repository
Browse code

import Devel::Cover 0.45

  • Loading branch information...
commit b768db32b22959413639aea00b999a3d1134bf2a 1 parent fd354c7
Paul Johnson authored

Showing 42 changed files with 662 additions and 347 deletions. Show diff stats Hide diff stats

  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
6 CHANGES
@@ -298,3 +298,9 @@ Release 0.44 - 18th May 2004
298 298 - Fix up gcov2perl.
299 299 - Fail gracefully when covering a threaded program.
300 300 - Add DEVEL_COVER_OPTIONS environment variable.
  301 +
  302 +Release 0.45 - 27th May 2004
  303 + - Cope with spaces in build path on Windows (Max Maischein).
  304 + - Allow Devel::Cover to be used under mod_perl (Philippe M. Chiasson).
  305 + - Handle $x ||= 1 and friends nicely, including subs and *foo{THING}.
  306 + - Allow uncoverable code to be specified. (Unfinished)
5 Cover.xs
@@ -176,7 +176,7 @@ static void set_firsts_if_neeed()
176 176 SV *init = (SV *)get_cv("Devel::Cover::first_init", 0);
177 177 SV *end = (SV *)get_cv("Devel::Cover::first_end", 0);
178 178 NDEB(svdump(end));
179   - if (av_len(PL_initav) >= 0)
  179 + if (PL_initav && av_len(PL_initav) >= 0)
180 180 {
181 181 SV **cv = av_fetch(PL_initav, 0, 0);
182 182 if (*cv != init)
@@ -185,7 +185,7 @@ static void set_firsts_if_neeed()
185 185 av_store(PL_initav, 0, init);
186 186 }
187 187 }
188   - if (av_len(PL_endav) >= 0)
  188 + if (PL_endav && av_len(PL_endav) >= 0)
189 189 {
190 190 SV **cv = av_fetch(PL_endav, 0, 0);
191 191 if (*cv != end)
@@ -396,7 +396,6 @@ static void cover_logop() {
396 396 if (right->op_type == OP_NEXT ||
397 397 right->op_type == OP_LAST ||
398 398 right->op_type == OP_REDO ||
399   - right->op_type == OP_REDO ||
400 399 right->op_type == OP_GOTO ||
401 400 right->op_type == OP_RETURN)
402 401 {
3  MANIFEST
@@ -64,6 +64,8 @@ tests/t0
64 64 tests/t1
65 65 tests/t2
66 66 tests/trivial
  67 +tests/uncoverable
  68 +tests/.uncoverable
67 69 tests/Alias1.pm
68 70 tests/Module1.pm
69 71 tests/Module2.pm
@@ -136,3 +138,4 @@ test_output/cover/t2.5.008
136 138 test_output/cover/t2.5.008001
137 139 test_output/cover/trivial.5.006001
138 140 test_output/cover/trivial.5.008
  141 +test_output/cover/uncoverable.5.006001
2  META.yml
... ... @@ -1,7 +1,7 @@
1 1 # http://module-build.sourceforge.net/META-spec.html
2 2 #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
3 3 name: Devel-Cover
4   -version: 0.44
  4 +version: 0.45
5 5 version_from:
6 6 installdirs: site
7 7 requires:
23 Makefile.PL
@@ -19,8 +19,8 @@ use File::Copy;
19 19
20 20 $| = 1;
21 21
22   -my $Version = "0.44";
23   -my $Date = "18th May 2004";
  22 +my $Version = "0.45";
  23 +my $Date = "27th May 2004";
24 24 my $Author = 'pjcj@cpan.org';
25 25
26 26 my @perlbug = ("perlbug", "-a", $Author,
@@ -32,7 +32,8 @@ my @versions = grep { $_ ne "README" && $_ ne "Makefile.PL" } @files;
32 32
33 33 my $base = getcwd;
34 34
35   -my %inc = map { ($_ eq "." ? $_ : Cwd::abs_path($_)) => 1 } @INC;
  35 +my %inc = map { -d $_ ? (($_ eq "." ? $_ : Cwd::abs_path($_)) => 1) : () }
  36 + @INC;
36 37 my @inc = sort keys %inc;
37 38
38 39 open I, ">lib/Devel/Cover/Inc.pm"
@@ -72,7 +73,7 @@ opendir D, "tests" or die "Cannot opendir tests: $!";
72 73 for my $t (readdir D)
73 74 {
74 75 next unless -f "tests/$t";
75   - next if $t =~ /\.(pm|pl|version|org|bak)$/;
  76 + next if $t =~ /\.(pm|pl|version|org|bak|uncoverable)$/;
76 77 next if $t =~ /~$/;
77 78
78 79 if ($t =~ /\.t/)
@@ -354,12 +355,16 @@ COVER_OPTIONS =
354 355 _run : pure_all
355 356 \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)
356 357
  358 +UNCOVERABLE = \$(PERL) -e 'print "-uncoverable \$\$1 " if qx|grep __COVER__ \$\$ARGV[0]| =~ /__COVER__\\s+uncoverable\\s+(.*)/' tests/\$(TEST)
  359 +
357 360 html : _run
358   -\t \$(PERL) -Mblib cover
  361 +\t \$(PERL) -Mblib cover `\$(UNCOVERABLE)` -report html
  362 +
  363 +_out : _run
  364 +\t \$(PERL) -Mblib cover `\$(UNCOVERABLE)` -report text > \$(TEST).out
359 365
360   -text : html
361   -\t \$(PERL) -Mblib cover -report text > \$(TEST).out && \\
362   - gvim -d \$(TEST).out
  366 +text : _out
  367 +\t gvim -d \$(TEST).out
363 368
364 369 wrun : pure_all
365 370 \t \$(PERL) \$(TAINT) -Iblib/lib -Iblib/arch -MDevel::Cover=-ignore,blib,-merge,0 tests/\$(TEST)
@@ -373,7 +378,7 @@ FONT = 8x13
373 378 FONT = -sun-screen-medium-r-normal-*-*-70-*-*-m-*-sun-fontspecific
374 379 FONT = "Bitstream Vera Sans Mono 8"
375 380
376   -diff : _run
  381 +diff : _out
377 382 \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
378 383 \t gvim -d -font \$(FONT) `\$(PERL) -Mblib -MDevel::Cover::Test -e '\$\$t = Devel::Cover::Test->new("\$(TEST)"); print \$\$t->cover_gold'` \$(TEST).out
379 384
28 cover
@@ -12,9 +12,9 @@ require 5.6.1;
12 12 use strict;
13 13 use warnings;
14 14
15   -our $VERSION = "0.44";
  15 +our $VERSION = "0.45";
16 16
17   -use Devel::Cover::DB 0.44;
  17 +use Devel::Cover::DB 0.45;
18 18
19 19 use Cwd "abs_path";
20 20 use Data::Dumper;
@@ -24,12 +24,13 @@ use Pod::Usage;
24 24
25 25 my $Options =
26 26 {
27   - coverage => [],
28   - delete => 0,
29   - exclude => [],
30   - file => [],
31   - report => "",
32   - summary => 1,
  27 + coverage => [],
  28 + delete => 0,
  29 + exclude => [],
  30 + file => [],
  31 + report => "",
  32 + summary => 1,
  33 + uncoverable => [],
33 34 };
34 35
35 36 sub get_options
@@ -54,6 +55,7 @@ sub get_options
54 55 report=s
55 56 silent!
56 57 summary!
  58 + uncoverable=s
57 59 version|v!
58 60 ));
59 61 Getopt::Long::Configure("nopass_through");
@@ -118,7 +120,11 @@ sub main
118 120 }
119 121
120 122 print "Reading database from $dbname\n" unless $Options->{silent};
121   - my $db = Devel::Cover::DB->new(db => $dbname);
  123 + my $db = Devel::Cover::DB->new
  124 + (
  125 + db => $dbname,
  126 + uncoverable => $Options->{uncoverable},
  127 + );
122 128 $db = $db->merge_runs;
123 129
124 130 for my $merge (@ARGV)
@@ -159,6 +165,8 @@ sub main
159 165
160 166 return unless length $Options->{report};
161 167
  168 + # use Data::Dumper; $Data::Dumper::Indent = 1; print Dumper $db->cover;
  169 +
162 170 my %f = map { $_ => 1 } (@{$Options->{file}}
163 171 ? map glob, @{$Options->{file}}
164 172 : $db->cover->items);
@@ -258,7 +266,7 @@ See the BUGS file.
258 266
259 267 =head1 VERSION
260 268
261   -Version 0.44 - 18th May 2004
  269 +Version 0.45 - 27th May 2004
262 270
263 271 =head1 LICENCE
264 272
10 cpancover
@@ -12,9 +12,9 @@ require 5.6.1;
12 12 use strict;
13 13 use warnings;
14 14
15   -our $VERSION = "0.44";
  15 +our $VERSION = "0.45";
16 16
17   -use Devel::Cover::DB 0.44;
  17 +use Devel::Cover::DB 0.45;
18 18
19 19 use Cwd ();
20 20 use File::Find ();
@@ -309,7 +309,7 @@ package Devel::Cover::Cpancover::Template::Provider;
309 309 use strict;
310 310 use warnings;
311 311
312   -our $VERSION = "0.44";
  312 +our $VERSION = "0.45";
313 313
314 314 use base "Template::Provider";
315 315
@@ -345,7 +345,7 @@ $Templates{html} = <<'EOT';
345 345
346 346 <!--
347 347
348   -This file was generated by Devel::Cover Version 0.44
  348 +This file was generated by Devel::Cover Version 0.45
349 349
350 350 Devel::Cover is copyright 2001-2004, Paul Johnson (pjcj@cpan.org)
351 351
@@ -455,7 +455,7 @@ The following exit values are returned:
455 455
456 456 =head1 VERSION
457 457
458   -Version 0.44 - 18th May 2004
  458 +Version 0.45 - 27th May 2004
459 459
460 460 =head1 LICENCE
461 461
4 create_gold
@@ -12,11 +12,11 @@ require 5.6.1;
12 12 use strict;
13 13 use warnings;
14 14
15   -our $VERSION = "0.44";
  15 +our $VERSION = "0.45";
16 16
17 17 use blib;
18 18
19   -use Devel::Cover::Test 0.44;
  19 +use Devel::Cover::Test 0.45;
20 20
21 21 my @tests = @ARGV;
22 22
6 gcov2perl
@@ -12,9 +12,9 @@ require 5.6.1;
12 12 use strict;
13 13 use warnings;
14 14
15   -our $VERSION = "0.44";
  15 +our $VERSION = "0.45";
16 16
17   -use Devel::Cover::DB 0.44;
  17 +use Devel::Cover::DB 0.45;
18 18
19 19 use Getopt::Long;
20 20 use Pod::Usage;
@@ -135,7 +135,7 @@ Huh?
135 135
136 136 =head1 VERSION
137 137
138   -Version 0.44 - 18th May 2004
  138 +Version 0.45 - 27th May 2004
139 139
140 140 =head1 LICENCE
141 141
43 lib/Devel/Cover.pm
@@ -10,13 +10,13 @@ package Devel::Cover;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use DynaLoader ();
16 16 our @ISA = "DynaLoader";
17 17
18   -use Devel::Cover::DB 0.44;
19   -use Devel::Cover::Inc 0.44;
  18 +use Devel::Cover::DB 0.45;
  19 +use Devel::Cover::Inc 0.45;
20 20
21 21 use B qw( class ppname main_cv main_start main_root walksymtable OPf_KIDS );
22 22 use B::Debug;
@@ -29,7 +29,8 @@ BEGIN { eval "use Pod::Coverage 0.06" } # We'll use this if it is available.
29 29
30 30 my $Initialised; # import() has been called.
31 31
32   -my $Dir; # Directory in cover will be gathered.
  32 +my $Dir; # Directory in which coverage will be
  33 + # collected.
33 34 my $DB = "cover_db"; # DB name.
34 35 my $Merge = 1; # Merge databases.
35 36 my $Summary = 1; # Output coverage summary.
@@ -77,13 +78,9 @@ BEGIN
77 78 BEGIN { @Inc = @Devel::Cover::Inc::Inc; @Ignore = ("/Devel/Cover[./]") }
78 79 # BEGIN { $^P = 0x004 | 0x010 | 0x100 | 0x200 }
79 80 BEGIN { $^P = 0x004 | 0x100 | 0x200 }
80   -# BEGIN { $^P = 0x004 | 0x100 }
81 81
82 82 {
83   -
84   - no warnings "void"; # Avoid "Too late to run CHECK block" warning.
85   -
86   - CHECK
  83 + sub check
87 84 {
88 85 return unless $Initialised;
89 86
@@ -112,6 +109,7 @@ EOM
112 109 @coverage ? " and " : "",
113 110 "$last.\n",
114 111 $nopod,
  112 + $ENV{MOD_PERL} ? " Collecting under $ENV{MOD_PERL}\n" : "",
115 113 "Selecting packages matching:", join("\n ", "", @Select), "\n",
116 114 "Ignoring packages matching:", join("\n ", "", @Ignore), "\n",
117 115 "Ignoring packages in:", join("\n ", "", @Inc), "\n"
@@ -123,6 +121,8 @@ EOM
123 121 $Run{start} = get_elapsed();
124 122 }
125 123
  124 + no warnings "void"; # Avoid "Too late to run CHECK block" warning.
  125 + CHECK { check }
126 126 }
127 127
128 128 {
@@ -234,6 +234,12 @@ sub import
234 234 %Coverage = (all => 1) unless keys %Coverage;
235 235
236 236 $Initialised = 1;
  237 +
  238 + if ($ENV{MOD_PERL})
  239 + {
  240 + check();
  241 + set_first_init_and_end();
  242 + }
237 243 }
238 244
239 245 sub cover_names_to_val
@@ -638,8 +644,10 @@ sub add_condition_cover
638 644
639 645 if ($type eq "or")
640 646 {
641   - my $name = $op->first->sibling->name;
642   - if ($name eq "const" || $name eq "srefgen")
  647 + my $r = $op->first->sibling;
  648 + my $name = $r->name;
  649 + $name = $r->first->name if $name eq "sassign";
  650 + if ($name =~ /^const|s?refgen|gelem$/)
643 651 {
644 652 $c = [ $c->[3], $c->[1] + $c->[2] ];
645 653 $count = 2;
@@ -776,6 +784,7 @@ sub B::Deparse::deparse
776 784 }
777 785
778 786 my $d = eval { $original_deparse->($self, @_) };
  787 + $d =~ s/^\010+//mg if defined $d;
779 788 $@ ? "Deparse error: $@" : $d
780 789 }
781 790
@@ -836,7 +845,7 @@ sub B::Deparse::logassignop
836 845
837 846 sub get_cover
838 847 {
839   - my $deparse = B::Deparse->new("-l");
  848 + my $deparse = B::Deparse->new;
840 849
841 850 my $cv = $deparse->{curcv} = shift;
842 851
@@ -1100,6 +1109,14 @@ Modules used by Devel::Cover while gathering coverage:
1100 1109
1101 1110 =back
1102 1111
  1112 +=head2 mod_perl
  1113 +
  1114 +By adding C<use Devel::Cover;> to your mod_perl startup script, you
  1115 +should be able to collect coverage information when running under
  1116 +mod_perl. You can also add any options you need at this point. I would
  1117 +suggest adding this as early as possible in your startup script in order
  1118 +to collect as much coverage information as possible.
  1119 +
1103 1120 =head1 BUGS
1104 1121
1105 1122 Did I mention that this is alpha code?
@@ -1108,7 +1125,7 @@ See the BUGS file. And the TODO file.
1108 1125
1109 1126 =head1 VERSION
1110 1127
1111   -Version 0.44 - 18th May 2004
  1128 +Version 0.45 - 27th May 2004
1112 1129
1113 1130 =head1 LICENCE
1114 1131
22 lib/Devel/Cover/Branch.pm
@@ -10,20 +10,28 @@ package Devel::Cover::Branch;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use base "Devel::Cover::Criterion";
16 16
17   -sub covered { (scalar grep $_, @{$_[0][0]}) }
18   -sub total { (scalar @{$_[0][0]}) }
  17 +sub uncoverable { $_[0][2][shift] }
  18 +sub covered { (scalar grep $_, @{$_[0][0]}) }
  19 +sub total { (scalar @{$_[0][0]}) }
19 20 sub percentage
20 21 {
21 22 my $t = $_[0]->total;
22 23 sprintf "%3d", $t ? $_[0]->covered / $t * 100 : 0
23 24 }
24   -sub error { scalar grep !$_, @{$_[0][0]} }
25   -sub text { $_[0][1]{text} }
26   -sub values { @{$_[0][0]} }
  25 +sub error
  26 +{
  27 + for (0 .. $#{$_[0][0]})
  28 + {
  29 + return 1 if $_[0][0][$_] xor !$_[0][2][$_]
  30 + }
  31 + 0
  32 +}
  33 +sub text { $_[0][1]{text} }
  34 +sub values { @{$_[0][0]} }
27 35
28 36 sub calculate_summary
29 37 {
@@ -76,7 +84,7 @@ Huh?
76 84
77 85 =head1 VERSION
78 86
79   -Version 0.44 - 18th May 2004
  87 +Version 0.45 - 27th May 2004
80 88
81 89 =head1 LICENCE
82 90
30 lib/Devel/Cover/Condition.pm
@@ -10,24 +10,32 @@ package Devel::Cover::Condition;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use base "Devel::Cover::Criterion";
16 16
17   -sub covered { (scalar grep $_, @{$_[0][0]}) }
18   -sub total { (scalar @{$_[0][0]}) }
  17 +sub uncoverable { $_[0][2][shift] }
  18 +sub covered { (scalar grep $_, @{$_[0][0]}) }
  19 +sub total { (scalar @{$_[0][0]}) }
19 20 sub percentage
20 21 {
21 22 my $t = $_[0]->total;
22 23 sprintf "%3d", $t ? $_[0]->covered / $t * 100 : 0
23 24 }
24   -sub error { scalar grep !$_, @{$_[0][0]} }
25   -sub text { "$_[0][1]{left} $_[0][1]{op} $_[0][1]{right}" }
26   -sub type { $_[0][1]{type} }
27   -sub pad { $_[0][0][$_] ||= 0 for 0 .. $_[0]->count - 1 }
28   -sub values { $_[0]->pad; @{$_[0][0]} }
29   -sub count { require Carp; Carp::confess "count() must be overridden" }
30   -sub headers { require Carp; Carp::confess "headers() must be overridden" }
  25 +sub error
  26 +{
  27 + for (0 .. $#{$_[0][0]})
  28 + {
  29 + return 1 if $_[0][0][$_] xor !$_[0][2][$_]
  30 + }
  31 + 0
  32 +}
  33 +sub text { "$_[0][1]{left} $_[0][1]{op} $_[0][1]{right}" }
  34 +sub type { $_[0][1]{type} }
  35 +sub pad { $_[0][0][$_] ||= 0 for 0 .. $_[0]->count - 1 }
  36 +sub values { $_[0]->pad; @{$_[0][0]} }
  37 +sub count { require Carp; Carp::confess "count() must be overridden" }
  38 +sub headers { require Carp; Carp::confess "headers() must be overridden" }
31 39
32 40 sub calculate_summary
33 41 {
@@ -80,7 +88,7 @@ Huh?
80 88
81 89 =head1 VERSION
82 90
83   -Version 0.44 - 18th May 2004
  91 +Version 0.45 - 27th May 2004
84 92
85 93 =head1 LICENCE
86 94
4 lib/Devel/Cover/Condition_and_3.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_and_3;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use base "Devel::Cover::Condition";
16 16
@@ -46,7 +46,7 @@ Huh?
46 46
47 47 =head1 VERSION
48 48
49   -Version 0.44 - 18th May 2004
  49 +Version 0.45 - 27th May 2004
50 50
51 51 =head1 LICENCE
52 52
4 lib/Devel/Cover/Condition_or_2.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_or_2;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use base "Devel::Cover::Condition";
16 16
@@ -46,7 +46,7 @@ Huh?
46 46
47 47 =head1 VERSION
48 48
49   -Version 0.44 - 18th May 2004
  49 +Version 0.45 - 27th May 2004
50 50
51 51 =head1 LICENCE
52 52
4 lib/Devel/Cover/Condition_or_3.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_or_3;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use base "Devel::Cover::Condition";
16 16
@@ -46,7 +46,7 @@ Huh?
46 46
47 47 =head1 VERSION
48 48
49   -Version 0.44 - 18th May 2004
  49 +Version 0.45 - 27th May 2004
50 50
51 51 =head1 LICENCE
52 52
4 lib/Devel/Cover/Condition_xor_4.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Condition_xor_4;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use base "Devel::Cover::Condition";
16 16
@@ -45,7 +45,7 @@ Huh?
45 45
46 46 =head1 VERSION
47 47
48   -Version 0.44 - 18th May 2004
  48 +Version 0.45 - 27th May 2004
49 49
50 50 =head1 LICENCE
51 51
26 lib/Devel/Cover/Criterion.pm
@@ -10,18 +10,18 @@ package Devel::Cover::Criterion;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
14   -
15   -use Devel::Cover::Statement 0.44;
16   -use Devel::Cover::Branch 0.44;
17   -use Devel::Cover::Condition 0.44;
18   -use Devel::Cover::Condition_or_2 0.44;
19   -use Devel::Cover::Condition_or_3 0.44;
20   -use Devel::Cover::Condition_and_3 0.44;
21   -use Devel::Cover::Condition_xor_4 0.44;
22   -use Devel::Cover::Subroutine 0.44;
23   -use Devel::Cover::Time 0.44;
24   -use Devel::Cover::Pod 0.44;
  13 +our $VERSION = "0.45";
  14 +
  15 +use Devel::Cover::Statement 0.45;
  16 +use Devel::Cover::Branch 0.45;
  17 +use Devel::Cover::Condition 0.45;
  18 +use Devel::Cover::Condition_or_2 0.45;
  19 +use Devel::Cover::Condition_or_3 0.45;
  20 +use Devel::Cover::Condition_and_3 0.45;
  21 +use Devel::Cover::Condition_xor_4 0.45;
  22 +use Devel::Cover::Subroutine 0.45;
  23 +use Devel::Cover::Time 0.45;
  24 +use Devel::Cover::Pod 0.45;
25 25
26 26 sub coverage { $_[0][0] }
27 27 sub information { $_[0][1] }
@@ -71,7 +71,7 @@ Huh?
71 71
72 72 =head1 VERSION
73 73
74   -Version 0.44 - 18th May 2004
  74 +Version 0.45 - 27th May 2004
75 75
76 76 =head1 LICENCE
77 77
85 lib/Devel/Cover/DB.pm
@@ -10,17 +10,17 @@ package Devel::Cover::DB;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15   -use Devel::Cover::Criterion 0.44;
16   -use Devel::Cover::DB::File 0.44;
17   -use Devel::Cover::DB::Structure 0.44;
  15 +use Devel::Cover::Criterion 0.45;
  16 +use Devel::Cover::DB::File 0.45;
  17 +use Devel::Cover::DB::Structure 0.45;
18 18
19 19 use Carp;
20 20 use File::Path;
21 21 use Storable;
22 22
23   -my $DB = "cover.10"; # Version 10 of the database.
  23 +my $DB = "cover.11"; # Version 11 of the database.
24 24
25 25 sub new
26 26 {
@@ -33,6 +33,7 @@ sub new
33 33 [ qw( stmt branch path cond sub pod time ) ],
34 34 runs => {},
35 35 collected => {},
  36 + uncoverable => [],
36 37 @_
37 38 };
38 39
@@ -360,6 +361,29 @@ sub print_summary
360 361 sub add_statement
361 362 {
362 363 my $self = shift;
  364 + my ($cc, $sc, $fc, $uc) = @_;
  365 + my %line;
  366 + for my $i (0 .. $#$fc)
  367 + {
  368 + my $l = $sc->[$i];
  369 + unless (defined $l)
  370 + {
  371 + # use Data::Dumper;
  372 + # print STDERR "sc ", scalar @$sc, ", fc ", scalar @$fc, "\n";
  373 + # print STDERR "sc ", Dumper($sc), "fc ", Dumper($fc);
  374 + warn "Devel::Cover: ignoring extra statement\n";
  375 + return;
  376 + }
  377 + my $n = $line{$l}++;
  378 + no warnings "uninitialized";
  379 + $cc->{$l}[$n][0] += $fc->[$i];
  380 + $cc->{$l}[$n][1] ||= $uc->{$l}[$n][0][1];
  381 + }
  382 +}
  383 +
  384 +sub add_time
  385 +{
  386 + my $self = shift;
363 387 my ($cc, $sc, $fc) = @_;
364 388 my %line;
365 389 for my $i (0 .. $#$fc)
@@ -383,7 +407,7 @@ sub add_statement
383 407 sub add_branch
384 408 {
385 409 my $self = shift;
386   - my ($cc, $sc, $fc) = @_;
  410 + my ($cc, $sc, $fc, $uc) = @_;
387 411 my %line;
388 412 for my $i (0 .. $#$fc)
389 413 {
@@ -406,13 +430,14 @@ sub add_branch
406 430 {
407 431 $cc->{$l}[$n] = [ $fc->[$i], $sc->[$i][1] ];
408 432 }
  433 + $cc->{$l}[$n][2][$_->[0]] ||= $_->[1] for @{$uc->{$l}[$n]};
409 434 }
410 435 }
411 436
412 437 sub add_subroutine
413 438 {
414 439 my $self = shift;
415   - my ($cc, $sc, $fc) = @_;
  440 + my ($cc, $sc, $fc, $uc) = @_;
416 441 my %line;
417 442 for my $i (0 .. $#$fc)
418 443 {
@@ -435,12 +460,36 @@ sub add_subroutine
435 460 {
436 461 $cc->{$l}[$n] = [ $fc->[$i], $sc->[$i][1] ];
437 462 }
  463 + $cc->{$l}[$n][2] ||= $uc->{$l}[$n][0][1];
438 464 }
439 465 }
440 466
441   -*add_condition = \&add_branch;
442   -*add_pod = \&add_subroutine;
443   -*add_time = \&add_statement;
  467 +*add_condition = \&add_branch;
  468 +*add_pod = \&add_subroutine;
  469 +
  470 +sub uncoverable
  471 +{
  472 + my $self = shift;
  473 +
  474 + my $u = {};
  475 +
  476 + my $f = ".uncoverable";
  477 + for my $file ($f, glob("~/$f"), @{$self->{uncoverable}})
  478 + {
  479 + open F, $file or next;
  480 + print STDERR "Devel::Cover: reading uncoverable information ",
  481 + "from $file\n"
  482 + unless $Devel::Cover::Silent;
  483 + while (<F>)
  484 + {
  485 + chomp;
  486 + my ($md5, $crit, $line, $count, $type, $reason) = split " ", $_, 6;
  487 + push @{$u->{$md5}{$crit}{$line}[$count]}, [$type, $reason];
  488 + }
  489 + }
  490 +
  491 + $u
  492 +}
444 493
445 494 sub cover
446 495 {
@@ -451,6 +500,8 @@ sub cover
451 500 my %digests;
452 501 my %files;
453 502 my $cover = $self->{cover} = {};
  503 + my $uncoverable = $self->uncoverable;
  504 +
454 505 while (my ($run, $r) = each %{$self->{runs}})
455 506 {
456 507 @{$self->{collected}}{@{$r->{collected}}} = ();
@@ -474,7 +525,10 @@ sub cover
474 525 digest => $digest,
475 526 );
476 527 # print "Structure from $st->{file}\n";
477   - # use Data::Dumper; print STDERR "st ", Dumper($st), "f ", Dumper($f);
  528 + # use Data::Dumper;
  529 + # print STDERR "st ", Dumper($st),
  530 + # "f ", Dumper($f),
  531 + # "uc ", Dumper($uncoverable->{$digest});
478 532 while (my ($criterion, $fc) = each %$f)
479 533 {
480 534 my $get = "get_$criterion";
@@ -482,7 +536,11 @@ sub cover
482 536 next unless $sc;
483 537 my $cc = $cf->{$criterion} ||= {};
484 538 my $add = "add_$criterion";
485   - $self->$add($cc, $sc, $fc);
  539 + $self->$add($cc, $sc, $fc, $uncoverable->{$digest}{$criterion});
  540 + # $cc - coverage being filled in
  541 + # $sc - structure information
  542 + # $fc - coverage from this file
  543 + # $uc - uncoverable information
486 544 }
487 545 }
488 546 }
@@ -572,7 +630,6 @@ sub cover
572 630 }
573 631
574 632 $self->{cover_valid} = 1;
575   -
576 633 $self->{cover}
577 634 }
578 635
@@ -655,7 +712,7 @@ Huh?
655 712
656 713 =head1 VERSION
657 714
658   -Version 0.44 - 18th May 2004
  715 +Version 0.45 - 27th May 2004
659 716
660 717 =head1 LICENCE
661 718
6 lib/Devel/Cover/DB/File.pm
@@ -10,9 +10,9 @@ package Devel::Cover::DB::File;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15   -use Devel::Cover::Criterion 0.44;
  15 +use Devel::Cover::Criterion 0.45;
16 16
17 17 sub calculate_summary
18 18 {
@@ -77,7 +77,7 @@ Huh?
77 77
78 78 =head1 VERSION
79 79
80   -Version 0.44 - 18th May 2004
  80 +Version 0.45 - 27th May 2004
81 81
82 82 =head1 LICENCE
83 83
4 lib/Devel/Cover/DB/Structure.pm
@@ -14,7 +14,7 @@ use Carp;
14 14 use Digest::MD5;
15 15 use Storable;
16 16
17   -our $VERSION = "0.44";
  17 +our $VERSION = "0.45";
18 18 our $AUTOLOAD;
19 19
20 20 sub new
@@ -150,7 +150,7 @@ Huh?
150 150
151 151 =head1 VERSION
152 152
153   -Version 0.44 - 18th May 2004
  153 +Version 0.45 - 27th May 2004
154 154
155 155 =head1 LICENCE
156 156
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.
12 12 use strict;
13 13 use warnings;
14 14
15   -our $VERSION = "0.44";
  15 +our $VERSION = "0.45";
16 16
17 17 use Devel::Cover qw( -ignore blib -ignore \\wB\\w );
18 18 use B::Concise qw( set_style add_callback );
@@ -112,7 +112,7 @@ Huh?
112 112
113 113 =head1 VERSION
114 114
115   -Version 0.44 - 18th May 2004
  115 +Version 0.45 - 27th May 2004
116 116
117 117 =head1 LICENCE
118 118
13 lib/Devel/Cover/Pod.pm
@@ -10,16 +10,17 @@ package Devel::Cover::Pod;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use base "Devel::Cover::Criterion";
16 16
17 17 BEGIN { eval "use Pod::Coverage 0.06" } # We'll use this if it is available.
18 18
19   -sub covered { $_[0][0] ? 1 : 0 }
20   -sub total { 1 }
21   -sub percentage { $_[0][0] ? 100 : 0 }
22   -sub error { !$_[0][0] }
  19 +sub uncoverable { $_[0][2] }
  20 +sub covered { $_[0][0] ? 1 : 0 }
  21 +sub total { 1 }
  22 +sub percentage { $_[0][0] ? 100 : 0 }
  23 +sub error { $_[0][0] xor !$_[0][2] }
23 24
24 25 sub calculate_summary
25 26 {
@@ -72,7 +73,7 @@ Huh?
72 73
73 74 =head1 VERSION
74 75
75   -Version 0.44 - 18th May 2004
  76 +Version 0.45 - 27th May 2004
76 77
77 78 =head1 LICENCE
78 79
4 lib/Devel/Cover/Report/Html.pm
@@ -10,7 +10,7 @@ package Devel::Cover::Report::Html;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use base "Devel::Cover::Report::Html_minimal";
16 16
@@ -45,7 +45,7 @@ Huh?
45 45
46 46 =head1 VERSION
47 47
48   -Version 0.44 - 18th May 2004
  48 +Version 0.45 - 27th May 2004
49 49
50 50 =head1 LICENCE
51 51
10 lib/Devel/Cover/Report/Html_basic.pm
@@ -10,9 +10,9 @@ package Devel::Cover::Report::Html_basic;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15   -use Devel::Cover::DB 0.44;
  15 +use Devel::Cover::DB 0.45;
16 16
17 17 use Template 2.00;
18 18
@@ -278,7 +278,7 @@ package Devel::Cover::Report::Html_basic::Template::Provider;
278 278 use strict;
279 279 use warnings;
280 280
281   -our $VERSION = "0.44";
  281 +our $VERSION = "0.45";
282 282
283 283 use base "Template::Provider";
284 284
@@ -314,7 +314,7 @@ $Templates{html} = <<'EOT';
314 314
315 315 <!--
316 316
317   -This file was generated by Devel::Cover Version 0.44
  317 +This file was generated by Devel::Cover Version 0.45
318 318
319 319 Devel::Cover is copyright 2001-2002, Paul Johnson (pjcj@cpan.org)
320 320
@@ -533,7 +533,7 @@ Huh?
533 533
534 534 =head1 VERSION
535 535
536   -Version 0.44 - 18th May 2004
  536 +Version 0.45 - 27th May 2004
537 537
538 538 =head1 LICENCE
539 539
10 lib/Devel/Cover/Report/Html_minimal.pm
@@ -4,10 +4,10 @@ use strict;
4 4 use warnings;
5 5 use CGI;
6 6 use Getopt::Long;
7   -use Devel::Cover::DB 0.44;
8   -use Devel::Cover::Truth_Table 0.44;
  7 +use Devel::Cover::DB 0.45;
  8 +use Devel::Cover::Truth_Table 0.45;
9 9
10   -our $VERSION = "0.44";
  10 +our $VERSION = "0.45";
11 11
12 12 #-------------------------------------------------------------------------------
13 13 # Subroutine : get_coverage_for_line
@@ -255,7 +255,7 @@ sub print_html_header {
255 255
256 256 print $fh <<"END_HTML";
257 257 <!--
258   -This file was generated by Devel::Cover Version 0.44
  258 +This file was generated by Devel::Cover Version 0.45
259 259 Devel::Cover is copyright 2001-2004, Paul Johnson (pjcj\@cpan.org)
260 260 Devel::Cover is free. It is licensed under the same terms as Perl itself.
261 261 The latest version of Devel::Cover should be available from my homepage:
@@ -759,7 +759,7 @@ Devel::Cover
759 759
760 760 =head1 VERSION
761 761
762   -Version 0.44 - 18th May 2004
  762 +Version 0.45 - 27th May 2004
763 763
764 764 =head1 LICENCE
765 765
12 lib/Devel/Cover/Report/Html_subtle.pm
@@ -2,10 +2,10 @@ package Devel::Cover::Report::Html_subtle;
2 2 use strict;
3 3 use warnings;
4 4
5   -our $VERSION = "0.44";
  5 +our $VERSION = "0.45";
6 6
7   -use Devel::Cover::DB 0.44;
8   -use Devel::Cover::Truth_Table 0.44;
  7 +use Devel::Cover::DB 0.45;
  8 +use Devel::Cover::Truth_Table 0.45;
9 9
10 10 use Template 2.00;
11 11 use CGI;
@@ -386,7 +386,7 @@ package Devel::Cover::Report::Html_subtle::Template::Provider;
386 386 use strict;
387 387 use warnings;
388 388
389   -our $VERSION = "0.44";
  389 +our $VERSION = "0.45";
390 390
391 391 use base "Template::Provider";
392 392
@@ -404,7 +404,7 @@ sub fetch {
404 404 $Templates{html} = <<'EOT';
405 405 <!--
406 406
407   -This file was generated by Devel::Cover Version 0.44
  407 +This file was generated by Devel::Cover Version 0.45
408 408
409 409 Devel::Cover is copyright 2001-2002, Paul Johnson (pjcj@cpan.org)
410 410
@@ -734,7 +734,7 @@ Huh?
734 734
735 735 =head1 VERSION
736 736
737   -Version 0.44 - 18th May 2004
  737 +Version 0.45 - 27th May 2004
738 738
739 739 =head1 LICENCE
740 740
6 lib/Devel/Cover/Report/Text.pm
@@ -10,9 +10,9 @@ package Devel::Cover::Report::Text;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15   -use Devel::Cover::DB 0.44;
  15 +use Devel::Cover::DB 0.45;
16 16
17 17 sub print_file
18 18 {
@@ -261,7 +261,7 @@ Huh?
261 261
262 262 =head1 VERSION
263 263
264   -Version 0.44 - 18th May 2004
  264 +Version 0.45 - 27th May 2004
265 265
266 266 =head1 LICENCE
267 267
6 lib/Devel/Cover/Report/Text2.pm
@@ -2,9 +2,9 @@ package Devel::Cover::Report::Text2;
2 2 use strict;
3 3 use warnings;
4 4
5   -our $VERSION = "0.44";
  5 +our $VERSION = "0.45";
6 6
7   -use Devel::Cover::DB 0.44;
  7 +use Devel::Cover::DB 0.45;
8 8 use Devel::Cover::Truth_Table;
9 9
10 10 my %format = (
@@ -191,7 +191,7 @@ Huh?
191 191
192 192 =head1 VERSION
193 193
194   -Version 0.44 - 18th May 2004
  194 +Version 0.45 - 27th May 2004
195 195
196 196 =head1 LICENCE
197 197
16 lib/Devel/Cover/Statement.pm
@@ -10,14 +10,16 @@ package Devel::Cover::Statement;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use base "Devel::Cover::Criterion";
16 16
17   -sub covered { ${$_[0]} }
18   -sub total { 1 }
19   -sub percentage { ${$_[0]} ? 100 : 0 }
20   -sub error { !${$_[0]} }
  17 +sub val { $_[0][0] }
  18 +sub uncoverable { $_[0][1] }
  19 +sub covered { $_[0][0] }
  20 +sub total { 1 }
  21 +sub percentage { $_[0][0] ? 100 : 0 }
  22 +sub error { $_[0][0] xor !$_[0][1] }
21 23
22 24 sub calculate_summary
23 25 {
@@ -31,7 +33,7 @@ sub calculate_summary
31 33 $s->{Total}{statement}{total}++;
32 34 $s->{Total}{total}{total}++;
33 35
34   - if ($$self)
  36 + if ($self->[0])
35 37 {
36 38 $s->{$file}{statement}{covered}++;
37 39 $s->{$file}{total}{covered}++;
@@ -68,7 +70,7 @@ Huh?
68 70
69 71 =head1 VERSION
70 72
71   -Version 0.44 - 18th May 2004
  73 +Version 0.45 - 27th May 2004
72 74
73 75 =head1 LICENCE
74 76
15 lib/Devel/Cover/Subroutine.pm
@@ -10,15 +10,16 @@ package Devel::Cover::Subroutine;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use base "Devel::Cover::Criterion";
16 16
17   -sub covered { $_[0][0] }
18   -sub total { 1 }
19   -sub percentage { $_[0][0] ? 100 : 0 }
20   -sub error { !$_[0][0] }
21   -sub name { $_[0][1] }
  17 +sub uncoverable { $_[0][2] }
  18 +sub covered { $_[0][0] }
  19 +sub total { 1 }
  20 +sub percentage { $_[0][0] ? 100 : 0 }
  21 +sub error { $_[0][0] xor !$_[0][2] }
  22 +sub name { $_[0][1] }
22 23
23 24 sub calculate_summary
24 25 {
@@ -69,7 +70,7 @@ Huh?
69 70
70 71 =head1 VERSION
71 72
72   -Version 0.44 - 18th May 2004
  73 +Version 0.45 - 27th May 2004
73 74
74 75 =head1 LICENCE
75 76
40 lib/Devel/Cover/Test.pm
@@ -10,14 +10,14 @@ package Devel::Cover::Test;
10 10 use strict;
11 11 use warnings;
12 12
13   -our $VERSION = "0.44";
  13 +our $VERSION = "0.45";
14 14
15 15 use Carp;