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/