Permalink
Browse files

Fix similar problem with branch coverage.

The fix is actually in the commit for condition coverage.  This commit adds
the provided test.
  • Loading branch information...
1 parent eedecbd commit b33679b36a9aadfe46db8f1561da43c83bff0334 @pjcj committed Sep 20, 2012
Showing with 176 additions and 1 deletion.
  1. +1 −0 Changes
  2. +113 −0 test_output/cover/dbm_cond.5.008005
  3. +61 −0 tests/dbm_cond
  4. +1 −1 tests/moo_cond
View
1 Changes
@@ -3,6 +3,7 @@ Devel::Cover history
{{$NEXT}}
- Fix loss of condition coverage data when first operand calls into ignored
file (Celogeek, Christian Walde) (rt 63090) (github 15, 20).
+ - Fix similar problem with branch coverage (Robert Freimuth) (rt 72027).
Release 0.94 - 18 September 2012
- Officially support 5.16.1.
View
113 test_output/cover/dbm_cond.5.008005
@@ -0,0 +1,113 @@
+Reading database from ...
+
+
+------------------------------------------ ------ ------ ------ ------ ------
+File stmt bran cond sub total
+------------------------------------------ ------ ------ ------ ------ ------
+tests/dbm_cond 100.0 100.0 n/a 100.0 100.0
+Total 100.0 100.0 n/a 100.0 100.0
+------------------------------------------ ------ ------ ------ ------ ------
+
+
+Run: ...
+Perl version: ...
+OS: ...
+Start: ...
+Finish: ...
+
+tests/dbm_cond
+
+line err stmt bran cond sub code
+1 #!/usr/bin/perl
+2
+3 # Copyright 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.008005 || !(eval "use DBM::Deep; 23")
+11 # __COVER__ skip_reason DBM::Deep not available
+12
+13 1 1 use strict;
+ 1
+ 1
+14 1 1 use warnings;
+ 1
+ 1
+15
+16 1 1 use Test::More;
+ 1
+ 1
+17
+18 1 1 use DBM::Deep;
+ 1
+ 1
+19
+20 1 my $db = DBM::Deep->new( "temp.db" );
+21 1 $db->{1} = 1;
+22
+23 1 my $h = { 1 => 1 };
+24
+25 sub testdbm
+26 {
+27 2 2 my ( $p ) = @_;
+28
+29 2 100 if( exists $db->{$p} )
+30 {
+31 1 return "dbm: exists";
+32 }
+33 else
+34 {
+35 1 return "dbm: does not exist";
+36 }
+37 }
+38
+39 sub testh
+40 {
+41 2 2 my ( $p ) = @_;
+42
+43 2 100 if( exists $h->{$p} )
+44 {
+45 1 return "h: exists";
+46 }
+47 else
+48 {
+49 1 return "h: does not exist";
+50 }
+51 }
+52
+53 1 is( testdbm( 1 ), "dbm: exists", "key exists in dbm" );
+54 1 is( testdbm( 2 ), "dbm: does not exist", "key does not exist in dbm" );
+55
+56 1 is( testh( 1 ), "h: exists", "key exists in h" );
+57 1 is( testh( 2 ), "h: does not exist", "key does not exist in h" );
+58
+59 1 unlink "temp.db";
+60
+61 1 done_testing();
+
+
+Branches
+--------
+
+line err % true false branch
+----- --- ------ ------ ------ ------
+29 100 1 1 if (exists $$db{$p}) { }
+43 100 1 1 if (exists $$h{$p}) { }
+
+
+Covered Subroutines
+-------------------
+
+Subroutine Count Location
+---------- ----- -----------------
+BEGIN 1 tests/dbm_cond:13
+BEGIN 1 tests/dbm_cond:14
+BEGIN 1 tests/dbm_cond:16
+BEGIN 1 tests/dbm_cond:18
+testdbm 2 tests/dbm_cond:27
+testh 2 tests/dbm_cond:41
+
+
View
61 tests/dbm_cond
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+# Copyright 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.008005 || !(eval "use DBM::Deep; 23")
+# __COVER__ skip_reason DBM::Deep not available
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use DBM::Deep;
+
+my $db = DBM::Deep->new( "temp.db" );
+$db->{1} = 1;
+
+my $h = { 1 => 1 };
+
+sub testdbm
+{
+ my ( $p ) = @_;
+
+ if( exists $db->{$p} )
+ {
+ return "dbm: exists";
+ }
+ else
+ {
+ return "dbm: does not exist";
+ }
+}
+
+sub testh
+{
+ my ( $p ) = @_;
+
+ if( exists $h->{$p} )
+ {
+ return "h: exists";
+ }
+ else
+ {
+ return "h: does not exist";
+ }
+}
+
+is( testdbm( 1 ), "dbm: exists", "key exists in dbm" );
+is( testdbm( 2 ), "dbm: does not exist", "key does not exist in dbm" );
+
+is( testh( 1 ), "h: exists", "key exists in h" );
+is( testh( 2 ), "h: does not exist", "key does not exist in h" );
+
+unlink "temp.db";
+
+done_testing();
View
2 tests/moo_cond
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# Copyright 2011-2012, Paul Johnson (paul@pjcj.net)
+# Copyright 2012, Paul Johnson (paul@pjcj.net)
# This software is free. It is licensed under the same terms as Perl itself.

0 comments on commit b33679b

Please sign in to comment.