# we run 5.14+ - everything is in core
#
if (defined ${^GLOBAL_PHASE}) {
- eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }';
+ eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1'
+ or die $@;
}
# try to load the xs version if it was compiled
#
. "codepath.\n"
) if $CGI::SpeedyCGI::i_am_speedy;
-
my ($in_global_destruction, $before_is_installed);
sub in_global_destruction () { $in_global_destruction }
+# end_av trick suggested by liz++
+require B;
+my $add_endblock = sub {
+ push @{ B::end_av()->object_2svref }, sub { $in_global_destruction = 1 };
+};
+
# This block will fire towards the end of the program execution
-# Since there is no way for us to generate an END which will execute *last*
-# this is *NOT 100% INCOMPATIBLE* with XS/${^GLOBAL_PHASE}. We *may* end up
-# with a true in_gloal_destruction() in the middle of another END block
-# There are no practical cases where this matters.
+# Use it to inject an END block which is guaranteed to run last
+# (as long as something else doesn't inject yet another block in
+# the same manner afterwards, at which point it hardly matters
+# anyway)
#
-END {
- $in_global_destruction = 1;
-}
+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 {
+ # Perls compiled with THREADS_HAVE_PIDS do not copy end_av properly
+ # between threads, so B::end_av ends up returning a B::SPECIAL and it
+ # goes downhill from there
+ # Install a noop END just to be on the safe side
+ { local $@; eval 'END {}' }
+ $add_endblock->();
+ goto $target
+ },
+ @_,
+ );
+
goto $orig_create;
};
+
$before_is_installed = 1;
}
Arthur Axel 'fREW' Schmidt E<lt>frioux@gmail.comE<gt>
+Elizabeth Mattijsen E<lt>liz@dijkmat.nlE<gt>
+
=head1 COPYRIGHT
Copyright (c) 2008 Yuval Kogman. All rights reserved