X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDevel%2FGlobalDestruction.pm;h=0854e9e562f732428d22f7dd962976f81317a1d3;hb=b0a035507f914f06e89ef9ddbaafb3bd7a049777;hp=dc4aa354df9aa2fc3356e1a3f94790ebbbf046e8;hpb=140a3884a09b85a2f4c988ffea726455e194066d;p=p5sagit%2FDevel-GlobalDestruction.git diff --git a/lib/Devel/GlobalDestruction.pm b/lib/Devel/GlobalDestruction.pm index dc4aa35..0854e9e 100644 --- a/lib/Devel/GlobalDestruction.pm +++ b/lib/Devel/GlobalDestruction.pm @@ -57,19 +57,36 @@ my $add_endblock = sub { END { $add_endblock->() } # threads do not execute the global ENDs (it would be stupid). However -# one can register a new END via simple string eval within a thread, and +# one can register a new thread-local END from within a thread, and # achieve the same result. A logical place to do this would be CLONE, which # is claimed to run in the context of the new thread. However this does -# not really seem to be the case - any END evaled in a CLONE is ignored :( +# not really seem to be the case - any END inserted in a CLONE is ignored :( # Hence blatantly hooking threads::create # if ($INC{'threads.pm'}) { + require Scalar::Util; + my $orig_create = threads->can('create'); no warnings 'redefine'; + *threads::create = sub { - { local $@; eval 'END { $in_global_destruction = 1 }' }; + my $class = shift; + my $target = shift; + + unless ( (Scalar::Util::reftype($target)||'') eq 'CODE' ) { + no strict 'refs'; + $target = \&{ caller() . "::$target" }; + } + + @_ = ( + $class, + sub { $add_endblock->(); goto $target }, + @_, + ); + goto $orig_create; }; + $before_is_installed = 1; }