Paul Johnson <p...@pjcj.net> wrote:
> 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.
--
Aaron Crane ** http://aaroncrane.co.uk/
