Skip to content

Commit

Permalink
Fix missing coverage with Moose accessors.
Browse files Browse the repository at this point in the history 
Moose accessors on the LHS of logops were missing coverage.  This was due to
the artificial Moose generated filename not matching the filenames for which
coverage should be collected.  When this occurred on the LHS of a logop the
flag showing whether we were collecting coverage was still false and so
covlerage of the logop was missed.

The solution is to look inside the artificially generated filename for the
real filename.  Note that this solution is specific to Moose.

Add a test for this too.
  • Loading branch information
@pjcj
pjcj committed May 22, 2012
1 parent cc9924c commit 4283f27
Show file tree
Hide file tree
Showing 6 changed files with 297 additions and 1 deletion.
4 changes: 4 additions & 0 deletions Cover.xs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -735,6 +735,9 @@ static void cover_logop(pTHX)

dMY_CXT;

NDEB(D(L, "logop() at %p\n", PL_op));
NDEB(op_dump(PL_op));

if (!collecting(Condition))
return;

Expand Down Expand Up @@ -939,6 +942,7 @@ static OP *dc_andassign(pTHX)
static OP *dc_or(pTHX)
{
dMY_CXT;
NDEB(D(L, "dc_or() at %p (%d)\n", PL_op, collecting_here(aTHX)));
if (MY_CXT.covering && collecting_here(aTHX)) cover_logop(aTHX);
return MY_CXT.ppaddr[OP_OR](aTHX);
}
Expand Down
7 changes: 6 additions & 1 deletion lib/Devel/Cover.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -521,7 +521,7 @@ sub use_file
{
my ($file) = @_;

# warn "use_file($file)\n";
# print STDERR "use_file($file)\n";

# die "bad file" unless length $file;

Expand All @@ -531,8 +531,13 @@ sub use_file
while ($file =~ /^\(eval in \w+\) (.+)/) {
$file = $1;
}
while ($file =~ /\(defined at (.+) line \d+\)/) {
$file = $1;
}
$file =~ s/ \(autosplit into .*\)$//;

# print STDERR "==> use_file($file)\n";

return $Files{$file} if exists $Files{$file};
return 0 if $file =~ /\(eval \d+\)/ ||
$file =~ /^\.\.[\/\\]\.\.[\/\\]lib[\/\\](?:Storable|POSIX).pm$/;
Expand Down
84 changes: 84 additions & 0 deletions test_output/cover/moose_cond.5.010000
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,84 @@
Reading database from ...


------------------------------------------ ------ ------ ------ ------ ------
File stmt bran cond sub total
------------------------------------------ ------ ------ ------ ------ ------
tests/moose_cond 100.0 n/a 75.0 100.0 96.2
Total 100.0 n/a 75.0 100.0 96.2
------------------------------------------ ------ ------ ------ ------ ------


Run: ...
Perl version: ...
OS: ...
Start: ...
Finish: ...

tests/moose_cond

line err stmt bran cond sub code
1 #!/usr/bin/perl
2
3 # Copyright 2011-2012, Paul Johnson (paul@pjcj.net)
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__ skip_test $] < 5.010 || !(eval "use Moose; 23")
11 # __COVER__ skip_reason Moose not available or unreliable with Devel::Cover
12
13 1 1 use strict;
1
1
14 1 1 use warnings;
1
1
15
16 package Cover_branch_bug;
17
18 1 1 use Moose;
1
1
19 1 has meep => ( isa => 'HashRef', is => 'rw' );
20
21 1 my $self = __PACKAGE__->new;
22
23 1 $self->meep( { marp => 0 } );
24 1 print "meep contains " . $self->wagh . "\n";
25
26 1 $self->meep( { marp => 1 } );
27 1 print "meep contains " . $self->wagh . "\n";
28
29 sub wagh {
30 2 2 my ( $self ) = @_;
31 *** 2 50 my $x = $self || 0;
32 2 100 return $self->meep->{marp} || 0;
33 # return $self || 0;
34 }


Conditions
----------

or 2 conditions

line err % l !l expr
----- --- ------ ------ ------ ----
31 *** 50 2 0 $self || 0
32 100 1 1 $self->meep->{'marp'} || 0


Covered Subroutines
-------------------

Subroutine Count Location
---------- ----- -------------------
BEGIN 1 tests/moose_cond:13
BEGIN 1 tests/moose_cond:14
BEGIN 1 tests/moose_cond:18
wagh 2 tests/moose_cond:30


85 changes: 85 additions & 0 deletions test_output/cover/moose_cond.5.012001
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,85 @@
Devel::Cover: Can't find digest for accessor meep defined at /home/pjcj/g/perl/Devel--Cover/tests/moose_cond
Reading database from ...


------------------------------------------ ------ ------ ------ ------ ------
File stmt bran cond sub total
------------------------------------------ ------ ------ ------ ------ ------
tests/moose_cond 100.0 n/a 75.0 100.0 96.2
Total 100.0 n/a 75.0 100.0 96.2
------------------------------------------ ------ ------ ------ ------ ------


Run: ...
Perl version: ...
OS: ...
Start: ...
Finish: ...

tests/moose_cond

line err stmt bran cond sub code
1 #!/usr/bin/perl
2
3 # Copyright 2011-2012, Paul Johnson (paul@pjcj.net)
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__ skip_test $] < 5.010 || !(eval "use Moose; 23")
11 # __COVER__ skip_reason Moose not available or unreliable with Devel::Cover
12
13 1 1 use strict;
1
1
14 1 1 use warnings;
1
1
15
16 package Cover_branch_bug;
17
18 1 1 use Moose;
1
1
19 1 has meep => ( isa => 'HashRef', is => 'rw' );
20
21 1 my $self = __PACKAGE__->new;
22
23 1 $self->meep( { marp => 0 } );
24 1 print "meep contains " . $self->wagh . "\n";
25
26 1 $self->meep( { marp => 1 } );
27 1 print "meep contains " . $self->wagh . "\n";
28
29 sub wagh {
30 2 2 my ( $self ) = @_;
31 *** 2 50 my $x = $self || 0;
32 2 100 return $self->meep->{marp} || 0;
33 # return $self || 0;
34 }


Conditions
----------

or 2 conditions

line err % l !l expr
----- --- ------ ------ ------ ----
31 *** 50 2 0 $self || 0
32 100 1 1 $self->meep->{'marp'} || 0


Covered Subroutines
-------------------

Subroutine Count Location
---------- ----- -------------------
BEGIN 1 tests/moose_cond:13
BEGIN 1 tests/moose_cond:14
BEGIN 1 tests/moose_cond:18
wagh 2 tests/moose_cond:30


84 changes: 84 additions & 0 deletions test_output/cover/moose_cond.5.012002
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,84 @@
Reading database from ...


------------------------------------------ ------ ------ ------ ------ ------
File stmt bran cond sub total
------------------------------------------ ------ ------ ------ ------ ------
tests/moose_cond 100.0 n/a 75.0 100.0 96.2
Total 100.0 n/a 75.0 100.0 96.2
------------------------------------------ ------ ------ ------ ------ ------


Run: ...
Perl version: ...
OS: ...
Start: ...
Finish: ...

tests/moose_cond

line err stmt bran cond sub code
1 #!/usr/bin/perl
2
3 # Copyright 2011-2012, Paul Johnson (paul@pjcj.net)
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__ skip_test $] < 5.010 || !(eval "use Moose; 23")
11 # __COVER__ skip_reason Moose not available or unreliable with Devel::Cover
12
13 1 1 use strict;
1
1
14 1 1 use warnings;
1
1
15
16 package Cover_branch_bug;
17
18 1 1 use Moose;
1
1
19 1 has meep => ( isa => 'HashRef', is => 'rw' );
20
21 1 my $self = __PACKAGE__->new;
22
23 1 $self->meep( { marp => 0 } );
24 1 print "meep contains " . $self->wagh . "\n";
25
26 1 $self->meep( { marp => 1 } );
27 1 print "meep contains " . $self->wagh . "\n";
28
29 sub wagh {
30 2 2 my ( $self ) = @_;
31 *** 2 50 my $x = $self || 0;
32 2 100 return $self->meep->{marp} || 0;
33 # return $self || 0;
34 }


Conditions
----------

or 2 conditions

line err % l !l expr
----- --- ------ ------ ------ ----
31 *** 50 2 0 $self || 0
32 100 1 1 $self->meep->{'marp'} || 0


Covered Subroutines
-------------------

Subroutine Count Location
---------- ----- -------------------
BEGIN 1 tests/moose_cond:13
BEGIN 1 tests/moose_cond:14
BEGIN 1 tests/moose_cond:18
wagh 2 tests/moose_cond:30


34 changes: 34 additions & 0 deletions tests/moose_cond
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,34 @@
#!/usr/bin/perl

# Copyright 2011-2012, Paul Johnson (paul@pjcj.net)

# 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__ skip_test $] < 5.010 || !(eval "use Moose; 23")
# __COVER__ skip_reason Moose not available or unreliable with Devel::Cover

use strict;
use warnings;

package Cover_branch_bug;

use Moose;
has meep => ( isa => 'HashRef', is => 'rw' );

my $self = __PACKAGE__->new;

$self->meep( { marp => 0 } );
print "meep contains " . $self->wagh . "\n";

$self->meep( { marp => 1 } );
print "meep contains " . $self->wagh . "\n";

sub wagh {
my ( $self ) = @_;
my $x = $self || 0;
return $self->meep->{marp} || 0;
# return $self || 0;
}

0 comments on commit 4283f27

Please sign in to comment.