Permalink
Browse files

Fix missing coverage with Moose accessors.

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...
1 parent cc9924c commit 4283f27e4ade20c49816d48cd6ca586e4ecb8038 @pjcj committed May 22, 2012
View
@@ -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;
@@ -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);
}
View
@@ -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;
@@ -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$/;
@@ -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
+
+
@@ -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
+
+
@@ -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
+
+
View
@@ -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.