Make the pure-perl fallback work under -c (RT#78619)

[p5sagit/Devel-GlobalDestruction.git] / lib / Devel / GlobalDestruction.pm

diff --git a/lib/Devel/GlobalDestruction.pm b/lib/Devel/GlobalDestruction.pm
index 0854e9e..97eedd0 100644 (file)
--- a/lib/Devel/GlobalDestruction.pm
+++ b/lib/Devel/GlobalDestruction.pm
@@ -3,7 +3,7 @@ package Devel::GlobalDestruction;
 use strict;
 use warnings;
 
-our $VERSION = '0.08';
+our $VERSION = '0.09';
 
 use Sub::Exporter::Progressive -setup => {
   exports => [ qw(in_global_destruction) ],
@@ -13,7 +13,8 @@ use Sub::Exporter::Progressive -setup => {
 # 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
 #
@@ -24,6 +25,33 @@ elsif (eval {
 }) {
   # the eval already installed everything, nothing to do
 }
+# We need pure-perl and we are running under -c
+# None of the END-block trickery will work, use a global scope guard instead,
+# as it is more than adequate in this situation
+# The whole thing is in an eval to prevent perl from parsing it in the
+# first place where none of this is needed
+#
+elsif ($^C) {
+  eval <<'PP_IGD' or die $@;
+
+  my $in_global_destruction;
+
+  sub in_global_destruction () { $in_global_destruction }
+
+  {
+    package Devel::GlobalDestgruction::_MinusC::ScopeGuard;
+    sub DESTROY { shift->[0]->() };
+  }
+
+  no warnings 'once';
+  $Devel::GlobalDestgruction::_MinusC::guard = bless [sub {
+    $in_global_destruction = 1;
+  }], 'Devel::GlobalDestgruction::_MinusC::ScopeGuard';
+
+  1; # keep eval happy
+
+PP_IGD
+}
 # Not core nor XS
 # The whole thing is in an eval to prevent perl from parsing it in the
 # first place under perls where none of this is needed
@@ -80,7 +108,15 @@ if ($INC{'threads.pm'}) {
 
     @_ = (
       $class,
-      sub { $add_endblock->(); goto $target },
+      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
+      },
       @_,
     );