Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'master' of git://github.com/pjcj/Devel--Cover

  • Loading branch information...
commit c2b1e10becc7abfb727046979a6e427285b3d987 2 parents 45ca8f8 + 8575819
@maspalio maspalio authored
View
4 Changes
@@ -2,6 +2,10 @@ Devel::Cover history
{{$NEXT}}
+Release 0.83 - 30th March 2012
+ - Prefer JSON::XS for faster operation
+ - Rework testing framework (Xavier Caron)
+
Release 0.82 - 19th March 2012
- Do not distribute MYMETA.json (Olivier Mengué) (rt 75883).
View
7 Makefile.PL
@@ -18,7 +18,7 @@ use File::Copy;
$| = 1;
-my $Version = "0.82_01";
+my $Version = "0.83";
my $Author = 'pjcj@cpan.org';
my @perlbug = ("perlbug", "-a", $Author,
"-s", "Installation of Devel::Cover $Version");
@@ -124,7 +124,10 @@ use lib "$base/t";
use Devel::Cover::Test;
-Devel::Cover::Test->new("$t")->run_test;
+my \$test = Devel::Cover::Test->new("$t");
+\$test->run_test;
+no warnings;
+\$test # for create_gold
EOT
close T or die "Cannot close t/e2e/a$t.t: $!";
}
View
1  docs/RELEASE
@@ -26,3 +26,4 @@
8. Push the changes.
- The dzil Git::Push plugin hangs for me
$ git push
+ $ git push --tags
View
269 lib/Devel/Cover/Test.pm
@@ -15,31 +15,10 @@ use warnings;
use Carp;
use File::Spec;
-use Test;
+use Test ();
use Devel::Cover::Inc;
-=head1 NAME
-
-Devel::Cover::Test - Internal module for testing
-
-=head1 METHODS
-
-=cut
-
-=head2 new
-
- my $test = Devel::Cover::Test->new($test, criteria => $string)
-
-Constructor.
-
-"criteria" parameter (optional, defaults to "statement branch condition subroutine") is a space separated list of tokens.
-Supported tokens are "statement", "branch", "condition", "subroutine" and "pod".
-
-More optional parameters are supported. Refer to L</get_params> sub.
-
-=cut
-
sub new
{
my $class = shift;
@@ -54,7 +33,7 @@ sub new
eval "use Test::Differences";
my $differences = $INC{"Test/Differences.pm"};
-
+
my $self = bless
{
test => $test,
@@ -122,57 +101,24 @@ sub get_params
$self
}
-=head2 shell_quote
-
- my $quoted_item = shell_quote($item)
-
-Returns properly quoted item to cope with embedded spaces.
-
-=cut
-
sub shell_quote
{
my ($item) = @_;
-
+
$^O eq "MSWin32" ? (/ / and $_ = qq("$_")) : s/ /\\ /g for $item;
$item
};
-=head2 perl
-
- my $perl = $self->perl()
-
-Returns absolute path to Perl interpreter with proper -I options (blib-wise).
-
-=cut
-
sub perl
{
my $self = shift;
- join " ", map { shell_quote($_) } $Devel::Cover::Inc::Perl, map { "-I$Devel::Cover::Inc::Base/$_" } "", "blib/lib", "blib/arch"
+ join " ",
+ map shell_quote($_),
+ $Devel::Cover::Inc::Perl,
+ map "-I$Devel::Cover::Inc::Base/$_", "", "blib/lib", "blib/arch"
}
-=head2 test_command
-
- my $command = $self->test_command()
-
-Returns test command, made of:
-
-=over 4
-
-=item absolute path to Perl interpreter
-
-=item Devel::Cover -M option (if applicable)
-
-=item test file
-
-=item test file parameters (if applicable)
-
-=back
-
-=cut
-
sub test_command
{
my $self = shift;
@@ -181,7 +127,9 @@ sub test_command
unless ($self->{no_coverage})
{
$c .= " -MDevel::Cover=" .
- join(",", '-db', $self->{cover_db}, split ' ', $self->{test_parameters})
+ join ",",
+ "-db", $self->{cover_db},
+ split " ", $self->{test_parameters}
}
$c .= " " . shell_quote $self->test_file;
$c .= " " . $self->test_file_parameters;
@@ -189,24 +137,6 @@ sub test_command
$c
}
-=head2 cover_command
-
- my $command = $self->cover_command()
-
-Returns test command, made of:
-
-=over 4
-
-=item absolute path to Perl interpreter
-
-=item absolute path to cover script
-
-=item cover parameters
-
-=back
-
-=cut
-
sub cover_command
{
my $self = shift;
@@ -216,14 +146,6 @@ sub cover_command
$c
}
-=head2 test_file
-
- my $file = $self->test_file()
-
-Returns absolute path to test file.
-
-=cut
-
sub test_file
{
my $self = shift;
@@ -231,14 +153,6 @@ sub test_file
"$Devel::Cover::Inc::Base/tests/$self->{test}"
}
-=head2 test_file_parameters
-
- my $parameters = $self->test_file_parameters()
-
-Accessor to test_file_parameters property.
-
-=cut
-
sub test_file_parameters
{
my $self = shift;
@@ -246,19 +160,6 @@ sub test_file_parameters
exists $self->{test_file_parameters} ? $self->{test_file_parameters} : ""
}
-=head2 cover_gold
-
- my $file = cover_gold()
-
-Returns absolute path to expected (aka "gold") file.
-
-File is like TEST-VERSION where VERSION is a floating-point number (aka "decimal version").
-
-Gold file is likely to be dependent on Perl version.
-In such cases, a single gold file is selected from TEST-* files (DWIM oblige).
-
-=cut
-
sub cover_gold
{
my $self = shift;
@@ -284,17 +185,9 @@ sub cover_gold
$v = $ENV{DEVEL_COVER_GOLDEN_VERSION}
if exists $ENV{DEVEL_COVER_GOLDEN_VERSION};
- "$td/$test.$v"
+ ("$td/$test", $v eq "5.0" ? 0 : $v)
}
-=head2 run_command
-
- $self->run_command($command)
-
-Runs command, most likely obtained from L</test_command> sub.
-
-=cut
-
sub run_command
{
my $self = shift;
@@ -318,12 +211,15 @@ sub run_test
if ($self->{skip})
{
- plan tests => 1;
- skip($self->{skip}, 1);
+ Test::plan tests => 1;
+ Test::skip($self->{skip}, 1);
return;
}
- my $gold = $self->cover_gold;
+ my ($base, $v) = $self->cover_gold;
+ return 1 unless $v; # assume we are generating the golden results
+ my $gold = "$base.$v";
+
open I, $gold or die "Cannot open $gold: $!";
my @cover = <I>;
close I or die "Cannot close $gold: $!";
@@ -331,11 +227,11 @@ sub run_test
# print STDERR "gold from $gold\n", @cover if $self->{debug};
- plan tests => $self->{differences}
- ? 1
- : exists $self->{tests}
- ? $self->{tests}->(scalar @cover)
- : scalar @cover;
+ Test::plan tests => $self->{differences}
+ ? 1
+ : exists $self->{tests}
+ ? $self->{tests}->(scalar @cover)
+ : scalar @cover;
local $ENV{PERL5OPT};
@@ -346,7 +242,7 @@ sub run_test
$self->run_cover unless $self->{no_report};
$self->{end}->() if $self->{end};
-
+
1
}
@@ -418,7 +314,7 @@ sub run_cover
}
else
{
- $self->{no_coverage} ? ok 1 : ok $t, $c;
+ $self->{no_coverage} ? Test::ok 1 : Test::ok $t, $c;
last if $self->{no_coverage} && !@{$self->{cover}};
}
}
@@ -426,14 +322,14 @@ sub run_cover
{
no warnings "redefine";
local *Test::_quote = sub { "@_" };
- $self->{no_coverage} ? ok 1 : eq_or_diff(\@at, \@ac, "output");
+ $self->{no_coverage} ? Test::ok 1 : eq_or_diff(\@at, \@ac, "output");
}
elsif ($self->{no_coverage})
{
- ok 1 for @{$self->{cover}};
+ Test::ok 1 for @{$self->{cover}};
}
close T or die "Cannot close $cover_com: $!";
-
+
1
}
@@ -447,11 +343,11 @@ sub create_gold
$] != 5.006001 &&
$] != 5.008000;
- my $gold = $self->cover_gold;
- my $new_gold = $gold;
- $new_gold =~ s/(5\.\d+)$/$]/;
- my $gv = $1;
- my $ng = "";
+ my ($base, $v) = $self->cover_gold;
+ my $gold = "$base.$v";
+ my $new_gold = "$base.$]";
+ my $gv = $v;
+ my $ng = "";
unless (-e $new_gold)
{
@@ -490,7 +386,7 @@ sub create_gold
print STDERR "gv is $gv and this is $]\n" if $self->{debug};
print STDERR "gold is $gold and new_gold is $new_gold\n" if $self->{debug};
- unless ($gv eq "5.0" || $gv eq $])
+ unless ($gv eq "0" || $gv eq $])
{
open G, "$gold" or die "Cannot open $gold: $!";
my $g = do { local $/; <G> };
@@ -501,13 +397,13 @@ sub create_gold
# print "--[$g]--\n";
if ($ng eq $g)
{
- print "Output from $new_gold matches $gold\n";
+ print "matches $v";
unlink $new_gold;
}
}
$self->{end}->() if $self->{end};
-
+
1
}
@@ -515,6 +411,101 @@ sub create_gold
__END__
+=head1 NAME
+
+Devel::Cover::Test - Internal module for testing
+
+=head1 METHODS
+
+=cut
+
+=head2 new
+
+ my $test = Devel::Cover::Test->new($test, criteria => $string)
+
+Constructor.
+
+"criteria" parameter (optional, defaults to "statement branch condition
+subroutine") is a space separated list of tokens.
+Supported tokens are "statement", "branch", "condition", "subroutine" and
+"pod".
+
+More optional parameters are supported. Refer to L</get_params> sub.
+
+=head2 shell_quote
+
+ my $quoted_item = shell_quote($item)
+
+Returns properly quoted item to cope with embedded spaces.
+
+=head2 perl
+
+ my $perl = $self->perl()
+
+Returns absolute path to Perl interpreter with proper -I options (blib-wise).
+
+=head2 test_command
+
+ my $command = $self->test_command()
+
+Returns test command, made of:
+
+=over 4
+
+=item absolute path to Perl interpreter
+
+=item Devel::Cover -M option (if applicable)
+
+=item test file
+
+=item test file parameters (if applicable)
+
+=back
+
+=head2 cover_command
+
+ my $command = $self->cover_command()
+
+Returns test command, made of:
+
+=over 4
+
+=item absolute path to Perl interpreter
+
+=item absolute path to cover script
+
+=item cover parameters
+
+=back
+
+=head2 test_file
+
+ my $file = $self->test_file()
+
+Returns absolute path to test file.
+
+=head2 test_file_parameters
+
+ my $parameters = $self->test_file_parameters()
+
+Accessor to test_file_parameters property.
+
+=head2 cover_gold
+
+ my ($base, $v) = $self->cover_gold;
+
+Returns the absolute path of the base to the golden file and the suffix
+version number.
+
+$base comes from the name of the test and $v will be $] from the earliest perl
+version for which the golden results should be the same as for the current $]
+
+=head2 run_command
+
+ $self->run_command($command)
+
+Runs command, most likely obtained from L</test_command> sub.
+
=head1 BUGS
Huh?
View
49 test_output/cover/cmp_ok.5.0
@@ -1,49 +0,0 @@
-Reading database from
-
-
-- ------ ------ ------ ------ ------
-File stmt bran cond sub total
-- ------ ------ ------ ------ ------
-tests/cmp_ok 100.0 n/a n/a 100.0 100.0
-Total 100.0 n/a n/a 100.0 100.0
-- ------ ------ ------ ------ ------
-
-
-Run:
-Perl version:
-OS:
-Start:
-Finish:
-
-tests/cmp_ok
-
-line err stmt bran cond sub code
-1 #!/usr/bin/perl
-2
-3 # test case for RT #63568 https://rt.cpan.org/Public/Bug/Display.html?id=63568
-4
-5 #
-6
-7 # This software is free. It is licensed under the same terms as Perl itself.
-8
-9 # The latest version of this software should be available from my homepage:
-10 # http://www.pjcj.net
-11
-12 1 1 use Devel::Cover;
- 1
- 1
-13 1 1 use Test::More;
- 1
- 1
-14 1 cmp_ok('', 'eq', '');
-
-
-Covered Subroutines
--
-
-Subroutine Count Location
-- ----- ---------------
-BEGIN 1 tests/cmp_ok:12
-BEGIN 1 tests/cmp_ok:13
-
-
View
77 test_output/cover/inc_sub.5.012001
@@ -0,0 +1,77 @@
+Reading database from ...
+
+
+------------------------------------------ ------ ------ ------ ------ ------
+File stmt bran cond sub total
+------------------------------------------ ------ ------ ------ ------ ------
+tests/inc_sub 100.0 75.0 n/a 100.0 95.0
+Total 100.0 75.0 n/a 100.0 95.0
+------------------------------------------ ------ ------ ------ ------ ------
+
+
+Run: ...
+Perl version: ...
+OS: ...
+Start: ...
+Finish: ...
+
+tests/inc_sub
+
+line err stmt bran cond sub code
+1 #!/bin/perl
+2
+3 # Copyright 2002-2011, 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__ changes s/(2[12] )[23]/$1X/
+11 # __COVER__ changes s/(22 100 )[12]/$1X/
+12
+13 1 1 use lib ();
+ 1
+ 1
+14
+15 BEGIN
+16 {
+17 lib->import
+18 (
+19 sub
+20 {
+21 2 print map("[$_]", @_), "\n";
+22 2 100 return unless $_[1] eq "IncSub.pm";
+23 1 my $fh;
+24 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
+25 1 $fh
+26 }
+27 )
+28 1 1 }
+29
+30 1 1 use IncSub;
+ 1
+ 1
+31
+32 1 IncSub::check
+
+
+Branches
+--------
+
+line err % true false branch
+----- --- ------ ------ ------ ------
+22 100 1 1 unless $_[1] eq 'IncSub.pm'
+24 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
+
+
+Covered Subroutines
+-------------------
+
+Subroutine Count Location
+---------- ----- ----------------
+BEGIN 1 tests/inc_sub:13
+BEGIN 1 tests/inc_sub:28
+BEGIN 1 tests/inc_sub:30
+
+
View
77 test_output/cover/inc_sub.5.012002
@@ -0,0 +1,77 @@
+Reading database from ...
+
+
+------------------------------------------ ------ ------ ------ ------ ------
+File stmt bran cond sub total
+------------------------------------------ ------ ------ ------ ------ ------
+tests/inc_sub 100.0 75.0 n/a 100.0 95.0
+Total 100.0 75.0 n/a 100.0 95.0
+------------------------------------------ ------ ------ ------ ------ ------
+
+
+Run: ...
+Perl version: ...
+OS: ...
+Start: ...
+Finish: ...
+
+tests/inc_sub
+
+line err stmt bran cond sub code
+1 #!/bin/perl
+2
+3 # Copyright 2002-2011, 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__ changes s/(2[12] )[23]/$1X/
+11 # __COVER__ changes s/(22 100 )[12]/$1X/
+12
+13 1 1 use lib ();
+ 1
+ 1
+14
+15 BEGIN
+16 {
+17 lib->import
+18 (
+19 sub
+20 {
+21 3 print map("[$_]", @_), "\n";
+22 3 100 return unless $_[1] eq "IncSub.pm";
+23 1 my $fh;
+24 *** 1 50 open $fh, "tests/IncSub.pm" or die $!;
+25 1 $fh
+26 }
+27 )
+28 1 1 }
+29
+30 1 1 use IncSub;
+ 1
+ 1
+31
+32 1 IncSub::check
+
+
+Branches
+--------
+
+line err % true false branch
+----- --- ------ ------ ------ ------
+22 100 2 1 unless $_[1] eq 'IncSub.pm'
+24 *** 50 0 1 unless open $fh, 'tests/IncSub.pm'
+
+
+Covered Subroutines
+-------------------
+
+Subroutine Count Location
+---------- ----- ----------------
+BEGIN 1 tests/inc_sub:13
+BEGIN 1 tests/inc_sub:28
+BEGIN 1 tests/inc_sub:30
+
+
View
6 tests/change.t
@@ -60,4 +60,8 @@ my $test = Devel::Cover::Test->new
run_test => $run_test,
end => sub { unlink $ft },
no_report => 0,
-)->run_test;
+);
+
+$test->run_test;
+no warnings;
+$test # for create_gold
View
14 tests/cmp_ok
@@ -1,14 +0,0 @@
-#!/usr/bin/perl
-
-# test case for RT #63568 https://rt.cpan.org/Public/Bug/Display.html?id=63568
-
-# Copyright 2004-2011, 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
-
-use Devel::Cover;
-use Test::More;
-cmp_ok('', 'eq', '');
View
8 tests/eval_sub.t
@@ -39,11 +39,15 @@ my $run_test = sub
my $runs = 4;
-Devel::Cover::Test->new
+my $test = Devel::Cover::Test->new
(
"eval3",
golden_test => "eval_sub.t",
run_test => $run_test,
changes => [ 'if (/^Run: /) { $get_line->() for 1 .. 5; redo }' ],
tests => sub { $_[0] - $runs * 6 }, # number of lines deleted above
-)->run_test;
+);
+
+$test->run_test;
+no warnings;
+$test # for create_gold
View
8 tests/eval_use.t
@@ -36,11 +36,15 @@ my $run_test = sub
$test->run_command($test->test_command);
};
-Devel::Cover::Test->new
+my $test = Devel::Cover::Test->new
(
"eval2",
golden_test => "eval_use.t",
run_test => $run_test,
changes => [ 'if (/^Run: /) { $get_line->() for 1 .. 5; redo }' ],
tests => sub { $_[0] - 24 }, # number of lines deleted above
-)->run_test;
+);
+
+$test->run_test;
+no warnings;
+$test # for create_gold
View
6 tests/md5.t
@@ -52,4 +52,8 @@ my $test = Devel::Cover::Test->new
$t,
run_test => $run_test,
end => sub { unlink $ft },
-)->run_test;
+);
+
+$test->run_test;
+no warnings;
+$test # for create_gold
View
19 utils/create_gold
@@ -42,11 +42,16 @@ unless (@tests)
for my $test (@tests)
{
- my $d = "t/e2e";
- my $t = -e "$d/$test" ? "$d/$test" :
- -e "$d/a$test.t" ? "$d/a$test.t" :
- $test;
- print STDERR "creating golden results for $test\n";
- require $t or die "Can't require $t: $!";
- Devel::Cover::Test->new($test)->create_gold;
+ my $e = "t/e2e";
+ my ($file) = grep -e, "$e/$test", "$e/a$test.t";
+ $file ||= $test;
+ print STDERR "creating golden results for $test: ";
+ my $t;
+ {
+ no warnings "redefine";
+ local *Devel::Cover::Test::run_test = sub {};
+ $t = require $file or die "Can't require $file: $!";
+ }
+ $t->create_gold;
+ print "\n";
}
Please sign in to comment.
Something went wrong with that request. Please try again.