Devel::Cover and subroutine attributes

[David Cantrell]

Devel::Cover breaks my tests!

$ cat foo.pl
use strict;
use warnings;

use Test::More tests => 1;

use Attribute::Handlers;

my $attributed;
sub Foo :ATTR(CODE) {
my ($package, $symbol, $referent, $attr, $data) = @_;
$attributed = "$referent";
}

my $sub = sub :Foo(bar) {};

is($attributed, "$sub", "coderef with attributes is not re-cloned");

$ prove foo.pl
foo.pl .. ok
All tests successful.
Files=1, Tests=1, 0 wallclock secs ( 0.03 usr 0.01 sys + 0.02 cusr
0.00 csys = 0.05 CPU)
Result: PASS

$ PERL5OPT=-MDevel::Cover prove foo.pl
foo.pl .. 1/1
# Failed test 'coderef with attributes is not re-cloned'
# at foo.pl line 16.
# got: 'CODE(0x100ab7138)'
# expected: 'CODE(0x100adba80)'
# Looks like you failed 1 test of 1.
foo.pl .. Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/1 subtests

Has anyone else seen this before and have a work-around? Or got a Clue
for me on where to start patching Devel::Cover?

[Paul Johnson]

Post by David Cantrell
Devel::Cover breaks my tests!

Oops, sorry.

It seems that no one has any ideas about this, and I'm afraid that I
don't either without actually getting into it and starting to debug.

I'd guess that there's a 75% chance that the problem will lie within
Cover.xs, but I know that's not much of a clue.

I'll add this to the top of my virtual TODO list for Devel::Cover where
it will remain until the next time I get to work on Devel::Cover. Or
until something takes its place. Or until I forget about it. Hopefully
the former.

If you fancy adding it to github
(https://github.com/pjcj/Devel--Cover/issues?sort=created&direction=desc&state=open)
then at least I won't forget about it.

Thanks very much for reporting this problem. I think it's generally
important that attributes are properly supported under Devel::Cover, and
it's an area I've not really looked into yet.

[David Cantrell]

Post by Paul Johnson

Post by David Cantrell
Devel::Cover breaks my tests!

Oops, sorry.
...
If you fancy adding it to github
(https://github.com/pjcj/Devel--Cover/issues?sort=created&direction=desc&state=open)
then at least I won't forget about it.

Will do. Thanks.

[Paul Johnson]

Post by Paul Johnson

Post by David Cantrell
Devel::Cover breaks my tests!

I'd guess that there's a 75% chance that the problem will lie within
Cover.xs, but I know that's not much of a clue.

It turns out that the problem wasn't in Cover.xs. I thought that there
was a 50/50 chance that would happen ;-)

Anyway, I think the problem is actually a bug in perl itself. There's
more info in the bug report https://github.com/pjcj/Devel--Cover/issues/38
and my mail to p5p seeking clarification is at
http://www.nntp.perl.org/group/perl.perl5.porters/2012/12/msg196269.html

Thanks again for reporting the problem.

[Aaron Crane]

Post by Paul Johnson
Anyway, I think the problem is actually a bug in perl itself. There's
more info in the bug report https://github.com/pjcj/Devel--Cover/issues/38
and my mail to p5p seeking clarification is at
http://www.nntp.perl.org/group/perl.perl5.porters/2012/12/msg196269.html

I think that, if this is a bug in perl, the bug is that the two
coderefs are equal when not run under Devel::Cover or the debugger.
Which suggests that a way to work around it from Perl space would be
useful for cases like David's.

The issue is that attributes are applied to "internal" subroutines
only once (at compile time), regardless of how many "external"
closures are cloned from that subroutine at run time; further, when
perl isn't in debugging mode, it applies an optimisation that avoids
generating a run-time closure for anonymous subroutines with no free
lexical references. So the trick is to find a way to get from a
potentially-closure coderef to something identifying the "internal"
subroutine. There isn't a pure-Perl way to do that, but B ships with
core, and it lets us (a) extract a B::CV instance corresponding to a
coderef, and (b) find the CvSTART of that B::CV. Since the CvSTART
(or its referent, technically) is a representation of the C-level
address of the first op in the subroutine (in execution order), this
is good enough.

$ cat foo2.pl
use strict;
use warnings;

use Test::More tests => 1;

use B qw<svref_2object>;

# Returns an arbitrary non-reference value that should be stable across all
# closures which are clones of (the same thing as) $coderef.
sub subroutine_identity {
my $coderef = shift;
die "Not a CODE reference\n" if ref $coderef ne 'CODE';
my $cv = svref_2object($coderef);
die "Not a CV\n" if !$cv->isa('B::CV');
my $op = $cv->START;
return $$op;
}

my ($sub1, $sub2) = map { my $x = $_; sub { $x } } 1, 2;

is(subroutine_identity($sub1), subroutine_identity($sub2),
"Two closures of the same sub have the same identity");

$ prove foo2.pl
foo2.pl .. ok
All tests successful.
Files=1, Tests=1, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.02 cusr
0.00 csys = 0.04 CPU)
Result: PASS
$ PERL5OPT=-MDevel::Cover prove foo2.pl
foo2.pl .. ok
All tests successful.
Files=1, Tests=1, 0 wallclock secs ( 0.04 usr 0.01 sys + 0.30 cusr
0.02 csys = 0.37 CPU)
Result: PASS

This should also work across threads, since (AIUI) optrees are shared
across threads.

David, sorry I didn't think of this when you originally asked your
question on the Dancer list.