Permalink
Browse files

import Devel::Cover 0.45

  • Loading branch information...
1 parent fd354c7 commit b768db32b22959413639aea00b999a3d1134bf2a @pjcj committed Nov 3, 2004
View
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
Oops, something went wrong.

0 comments on commit b768db3

Please sign in to comment.