Skip to content

Commit

Permalink
Handle $y || undef.
Browse files Browse the repository at this point in the history
  • Loading branch information
pjcj committed Nov 8, 2004
1 parent 8a3acf0 commit d903387
Show file tree
Hide file tree
Showing 9 changed files with 122 additions and 99 deletions.
3 changes: 3 additions & 0 deletions CHANGES
@@ -1,5 +1,8 @@
Devel::Cover.pm history

Release 0.51 -
- Handle $y || undef.

Release 0.50 - 25th October 2004
- Add -test option to cover.
- Fix missing coverage when calling a sub in an ignored module.
Expand Down
1 change: 1 addition & 0 deletions TODO
Expand Up @@ -26,6 +26,7 @@
- Look at time coverage again - collecting for too many ops?
- Sort out time coverage on Windows.
- Check for core dumps with pod coverage.
- Uncovered dereferences as seen in svk.
- Testing:
- Be able to run Devel::Cover on itself.
- More comprehensive.
Expand Down
3 changes: 2 additions & 1 deletion lib/Devel/Cover.pm
Expand Up @@ -758,7 +758,8 @@ sub add_condition_cover
my $name = $r->name;
$name = $r->first->name if $name eq "sassign";
# TODO - exec? any others?
if ($name =~ /^const|s?refgen|gelem|die$/)
# print STDERR "Name [$name]\n";
if ($name =~ /^const|s?refgen|gelem|die|undef$/)
{
$c = [ $c->[3], $c->[1] + $c->[2] ];
$count = 2;
Expand Down
3 changes: 3 additions & 0 deletions lib/Devel/Cover/Report/Html_minimal.pm
Expand Up @@ -82,12 +82,14 @@ sub get_showing_headers {
sub truth_table {
return if @_ > 16;
my @lops;
my $n = 0;
foreach my $c (@_) {
my $op = $c->[1]{type};
my @hit = map {defined() && $_ > 0 ? 1 : 0} @{$c->[0]};
@hit = reverse @hit if $op =~ /^or_[23]$/;
my $t = {
tt => Devel::Cover::Truth_Table->new_primitive($op, @hit),
# tt => Devel::Cover::Truth_Table->new_primitive($op, $c, $n++);
cvg => $c->[1],
expr => join(' ', @{$c->[1]}{qw/left op right/}),
};
Expand Down Expand Up @@ -210,6 +212,7 @@ sub _branch_report {
#-------------------------------------------------------------------------------
sub _condition_report {
my $coverage = shift;
# use Data::Dumper; print STDERR Dumper $coverage;

my @tables = truth_table(@{$coverage->{condition}});
return unless @tables;
Expand Down
11 changes: 6 additions & 5 deletions lib/Devel/Cover/Truth_Table.pm
Expand Up @@ -124,11 +124,12 @@ sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my @args = @_;
# use Data::Dumper; print Dumper \@args;
return bless {
inputs => $args[0],
result => $args[1],
covered => $args[2],
error => $args[3], # TODO - pass this in
inputs => $args[0],
result => $args[1],
covered => $args[2],
criterion => $args[2],
}, $class;
}

Expand Down Expand Up @@ -172,7 +173,7 @@ sub covered {
}

sub error {
return 0;
return 1;
return $_[0]{error}[$_[1]];
}

Expand Down
66 changes: 35 additions & 31 deletions test_output/cover/cond_or.5.006001
Expand Up @@ -4,8 +4,8 @@ Reading database from /home/pjcj/g/perl/svk/dc/cover_db
------------------------------------------ ------ ------ ------ ------ ------
File stmt branch cond sub total
------------------------------------------ ------ ------ ------ ------ ------
tests/cond_or 93.9 50.0 65.9 0.0 74.7
Total 93.9 50.0 65.9 0.0 74.7
tests/cond_or 94.3 50.0 64.4 0.0 74.2
Total 94.3 50.0 64.4 0.0 74.2
------------------------------------------ ------ ------ ------ ------ ------


Expand Down Expand Up @@ -69,23 +69,25 @@ line err stmt branch cond sub code
47 11 100 my $r = $_ || "qqq";
48 11 100 my $s = $_ || [];
49 11 my $t = $y | $z;
50
51 *** 11 33 $p ||= $y;
52 *** 11 33 $p ||= $z;
53 *** 11 66 $x[ 6] ||= $y;
54 *** 11 33 $x[ 7] ||= $z;
55 11 100 $x[ 8] ||= 1;
56 11 100 $x[ 9] ||= {};
57 11 100 $x[10] ||= \"foo";
58 11 100 $x[11] ||= \$y;
59 11 100 $x[12] ||= \*STDIO;
60 *** 11 100 0 $x[13] ||= sub { 1 };
50 *** 11 50 my $u = $y || 0;
51 *** 11 50 my $v = $y || undef;
52
53 *** 11 33 $p ||= $y;
54 *** 11 33 $p ||= $z;
55 *** 11 66 $x[ 6] ||= $y;
56 *** 11 33 $x[ 7] ||= $z;
57 11 100 $x[ 8] ||= 1;
58 11 100 $x[ 9] ||= {};
59 11 100 $x[10] ||= \"foo";
60 11 100 $x[11] ||= \$y;
61 11 100 $x[12] ||= \*STDIO;
62 *** 11 100 0 $x[13] ||= sub { 1 };
*** 0
61 11 100 $x[14] ||= *::foo{SCALAR};
62 *** 11 50 $x[15] ||= *STDIO{IO};
63 }
64
65 # print join(", ", @x), "\n";
63 11 100 $x[14] ||= *::foo{SCALAR};
64 *** 11 50 $x[15] ||= *STDIO{IO};
65 }
66
67 # print join(", ", @x), "\n";


Branches
Expand All @@ -108,17 +110,19 @@ line err % l !l expr
----- --- ------ ------ ------ ----
47 100 10 1 $_ || 'qqq'
48 100 10 1 $_ || []
55 100 10 1 $x[8] ||= 1
56 100 10 1 $x[9] ||= {}
57 100 10 1 $x[10] ||= \('foo')
58 100 10 1 $x[11] ||= \$y
59 100 10 1 $x[12] ||= \*STDIO
60 100 10 1 $x[13] ||= sub {
50 *** 50 11 0 $y || 0
51 *** 50 11 0 $y || undef
57 100 10 1 $x[8] ||= 1
58 100 10 1 $x[9] ||= {}
59 100 10 1 $x[10] ||= \('foo')
60 100 10 1 $x[11] ||= \$y
61 100 10 1 $x[12] ||= \*STDIO
62 100 10 1 $x[13] ||= sub {
1;
}

61 100 10 1 $x[14] ||= *foo{'SCALAR'}
62 *** 50 0 11 $x[15] ||= *STDIO{'IO'}
63 100 10 1 $x[14] ||= *foo{'SCALAR'}
64 *** 50 0 11 $x[15] ||= *STDIO{'IO'}

or 3 conditions

Expand All @@ -127,17 +131,17 @@ line err % l !l&&r !l&&!r expr
24 *** 33 11 0 0 $y or $x[0]++
45 *** 33 11 0 0 $y || $z
46 *** 33 0 11 0 $z || $y
51 *** 33 11 0 0 $p ||= $y
52 *** 33 11 0 0 $p ||= $z
53 *** 66 10 1 0 $x[6] ||= $y
54 *** 33 0 0 11 $x[7] ||= $z
53 *** 33 11 0 0 $p ||= $y
54 *** 33 11 0 0 $p ||= $z
55 *** 66 10 1 0 $x[6] ||= $y
56 *** 33 0 0 11 $x[7] ||= $z


Uncovered Subroutines
---------------------

Subroutine Count Location
---------- ----- ----------------
__ANON__ 0 tests/cond_or:60
__ANON__ 0 tests/cond_or:62


66 changes: 35 additions & 31 deletions test_output/cover/cond_or.5.008
Expand Up @@ -4,8 +4,8 @@ Reading database from /home/pjcj/g/perl/svk/dc/cover_db
------------------------------------------ ------ ------ ------ ------ ------
File stmt branch cond sub total
------------------------------------------ ------ ------ ------ ------ ------
tests/cond_or 94.9 50.0 65.9 66.7 76.9
Total 94.9 50.0 65.9 66.7 76.9
tests/cond_or 95.1 50.0 64.4 66.7 76.3
Total 95.1 50.0 64.4 66.7 76.3
------------------------------------------ ------ ------ ------ ------ ------


Expand Down Expand Up @@ -73,23 +73,25 @@ line err stmt branch cond sub code
47 11 100 my $r = $_ || "qqq";
48 11 100 my $s = $_ || [];
49 11 my $t = $y | $z;
50
51 *** 11 33 $p ||= $y;
52 *** 11 33 $p ||= $z;
53 *** 11 66 $x[ 6] ||= $y;
54 *** 11 33 $x[ 7] ||= $z;
55 11 100 $x[ 8] ||= 1;
56 11 100 $x[ 9] ||= {};
57 11 100 $x[10] ||= \"foo";
58 11 100 $x[11] ||= \$y;
59 11 100 $x[12] ||= \*STDIO;
60 *** 11 100 0 $x[13] ||= sub { 1 };
50 *** 11 50 my $u = $y || 0;
51 *** 11 50 my $v = $y || undef;
52
53 *** 11 33 $p ||= $y;
54 *** 11 33 $p ||= $z;
55 *** 11 66 $x[ 6] ||= $y;
56 *** 11 33 $x[ 7] ||= $z;
57 11 100 $x[ 8] ||= 1;
58 11 100 $x[ 9] ||= {};
59 11 100 $x[10] ||= \"foo";
60 11 100 $x[11] ||= \$y;
61 11 100 $x[12] ||= \*STDIO;
62 *** 11 100 0 $x[13] ||= sub { 1 };
*** 0
61 11 100 $x[14] ||= *::foo{SCALAR};
62 *** 11 50 $x[15] ||= *STDIO{IO};
63 }
64
65 # print join(", ", @x), "\n";
63 11 100 $x[14] ||= *::foo{SCALAR};
64 *** 11 50 $x[15] ||= *STDIO{IO};
65 }
66
67 # print join(", ", @x), "\n";


Branches
Expand All @@ -112,17 +114,19 @@ line err % l !l expr
----- --- ------ ------ ------ ----
47 100 10 1 $_ || 'qqq'
48 100 10 1 $_ || []
55 100 10 1 $x[8] ||= 1
56 100 10 1 $x[9] ||= {}
57 100 10 1 $x[10] ||= \('foo')
58 100 10 1 $x[11] ||= \$y
59 100 10 1 $x[12] ||= \*STDIO
60 100 10 1 $x[13] ||= sub {
50 *** 50 11 0 $y || 0
51 *** 50 11 0 $y || undef
57 100 10 1 $x[8] ||= 1
58 100 10 1 $x[9] ||= {}
59 100 10 1 $x[10] ||= \('foo')
60 100 10 1 $x[11] ||= \$y
61 100 10 1 $x[12] ||= \*STDIO
62 100 10 1 $x[13] ||= sub {
1;
}

61 100 10 1 $x[14] ||= *foo{'SCALAR'}
62 *** 50 0 11 $x[15] ||= *STDIO{'IO'}
63 100 10 1 $x[14] ||= *foo{'SCALAR'}
64 *** 50 0 11 $x[15] ||= *STDIO{'IO'}

or 3 conditions

Expand All @@ -131,10 +135,10 @@ line err % l !l&&r !l&&!r expr
24 *** 33 11 0 0 $y or $x[0]++
45 *** 33 11 0 0 $y || $z
46 *** 33 0 11 0 $z || $y
51 *** 33 11 0 0 $p ||= $y
52 *** 33 11 0 0 $p ||= $z
53 *** 66 10 1 0 $x[6] ||= $y
54 *** 33 0 0 11 $x[7] ||= $z
53 *** 33 11 0 0 $p ||= $y
54 *** 33 11 0 0 $p ||= $z
55 *** 66 10 1 0 $x[6] ||= $y
56 *** 33 0 0 11 $x[7] ||= $z


Covered Subroutines
Expand All @@ -150,6 +154,6 @@ Uncovered Subroutines

Subroutine Count Location
---------- ----- ----------------
__ANON__ 0 tests/cond_or:60
__ANON__ 0 tests/cond_or:62


66 changes: 35 additions & 31 deletions test_output/cover/cond_or.5.008001
Expand Up @@ -4,8 +4,8 @@ Reading database from /home/pjcj/g/perl/svk/dc/cover_db
------------------------------------------ ------ ------ ------ ------ ------
File stmt branch cond sub total
------------------------------------------ ------ ------ ------ ------ ------
tests/cond_or 94.6 50.0 65.9 66.7 76.4
Total 94.6 50.0 65.9 66.7 76.4
tests/cond_or 94.9 50.0 64.4 66.7 75.8
Total 94.9 50.0 64.4 66.7 75.8
------------------------------------------ ------ ------ ------ ------ ------


Expand Down Expand Up @@ -71,23 +71,25 @@ line err stmt branch cond sub code
47 11 100 my $r = $_ || "qqq";
48 11 100 my $s = $_ || [];
49 11 my $t = $y | $z;
50
51 *** 11 33 $p ||= $y;
52 *** 11 33 $p ||= $z;
53 *** 11 66 $x[ 6] ||= $y;
54 *** 11 33 $x[ 7] ||= $z;
55 11 100 $x[ 8] ||= 1;
56 11 100 $x[ 9] ||= {};
57 11 100 $x[10] ||= \"foo";
58 11 100 $x[11] ||= \$y;
59 11 100 $x[12] ||= \*STDIO;
60 *** 11 100 0 $x[13] ||= sub { 1 };
50 *** 11 50 my $u = $y || 0;
51 *** 11 50 my $v = $y || undef;
52
53 *** 11 33 $p ||= $y;
54 *** 11 33 $p ||= $z;
55 *** 11 66 $x[ 6] ||= $y;
56 *** 11 33 $x[ 7] ||= $z;
57 11 100 $x[ 8] ||= 1;
58 11 100 $x[ 9] ||= {};
59 11 100 $x[10] ||= \"foo";
60 11 100 $x[11] ||= \$y;
61 11 100 $x[12] ||= \*STDIO;
62 *** 11 100 0 $x[13] ||= sub { 1 };
*** 0
61 11 100 $x[14] ||= *::foo{SCALAR};
62 *** 11 50 $x[15] ||= *STDIO{IO};
63 }
64
65 # print join(", ", @x), "\n";
63 11 100 $x[14] ||= *::foo{SCALAR};
64 *** 11 50 $x[15] ||= *STDIO{IO};
65 }
66
67 # print join(", ", @x), "\n";


Branches
Expand All @@ -110,17 +112,19 @@ line err % l !l expr
----- --- ------ ------ ------ ----
47 100 10 1 $_ || 'qqq'
48 100 10 1 $_ || []
55 100 10 1 $x[8] ||= 1
56 100 10 1 $x[9] ||= {}
57 100 10 1 $x[10] ||= \'foo'
58 100 10 1 $x[11] ||= \$y
59 100 10 1 $x[12] ||= \*STDIO
60 100 10 1 $x[13] ||= sub {
50 *** 50 11 0 $y || 0
51 *** 50 11 0 $y || undef
57 100 10 1 $x[8] ||= 1
58 100 10 1 $x[9] ||= {}
59 100 10 1 $x[10] ||= \'foo'
60 100 10 1 $x[11] ||= \$y
61 100 10 1 $x[12] ||= \*STDIO
62 100 10 1 $x[13] ||= sub {
1;
}

61 100 10 1 $x[14] ||= *foo{'SCALAR'}
62 *** 50 0 11 $x[15] ||= *STDIO{'IO'}
63 100 10 1 $x[14] ||= *foo{'SCALAR'}
64 *** 50 0 11 $x[15] ||= *STDIO{'IO'}

or 3 conditions

Expand All @@ -129,10 +133,10 @@ line err % l !l&&r !l&&!r expr
24 *** 33 11 0 0 $y or $x[0]++
45 *** 33 11 0 0 $y || $z
46 *** 33 0 11 0 $z || $y
51 *** 33 11 0 0 $p ||= $y
52 *** 33 11 0 0 $p ||= $z
53 *** 66 10 1 0 $x[6] ||= $y
54 *** 33 0 0 11 $x[7] ||= $z
53 *** 33 11 0 0 $p ||= $y
54 *** 33 11 0 0 $p ||= $z
55 *** 66 10 1 0 $x[6] ||= $y
56 *** 33 0 0 11 $x[7] ||= $z


Covered Subroutines
Expand All @@ -148,6 +152,6 @@ Uncovered Subroutines

Subroutine Count Location
---------- ----- ----------------
__ANON__ 0 tests/cond_or:60
__ANON__ 0 tests/cond_or:62


2 changes: 2 additions & 0 deletions tests/cond_or
Expand Up @@ -47,6 +47,8 @@ for (0 .. 10)
my $r = $_ || "qqq";
my $s = $_ || [];
my $t = $y | $z;
my $u = $y || 0;
my $v = $y || undef;

$p ||= $y;
$p ||= $z;
Expand Down

0 comments on commit d903387

Please sign in to comment.