From: Graham Knop <haarg@haarg.org>
Date: Thu, 22 Aug 2013 09:52:28 +0000 (-0400)
Subject: fix detection if loaded during global destruction
X-Git-Tag: Devel-GlobalDestruction-0.12~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=350bef653f634d1c7cb7357b45e1835b1489f9b7;p=p5sagit%2FDevel-GlobalDestruction.git

fix detection if loaded during global destruction
---

diff --git a/lib/Devel/GlobalDestruction.pm b/lib/Devel/GlobalDestruction.pm
index 2072b3e..9ce9a70 100644
--- a/lib/Devel/GlobalDestruction.pm
+++ b/lib/Devel/GlobalDestruction.pm
@@ -27,17 +27,11 @@ elsif (eval {
   # the eval already installed everything, nothing to do
 }
 else {
-  # internally, PL_main_start is nulled immediately before entering global destruction
-  # and we can use B to detect that.  It will also be null before the main runloop starts,
-  # so we check install a CHECK if needed to detect that.
+  # internally, PL_main_cv is set to Nullcv immediately before entering
+  # global destruction and we can use B to detect that.  B::main_cv will
+  # only ever be a B::CV or a B::SPECIAL that is a reference to 0
   require B;
-  my $started = !B::main_start()->isa(q[B::NULL]);
-  unless ($started) {
-    # work around 5.6 eval bug
-    eval '0 && $started; CHECK { $started = 1 }; 1'
-      or die $@;
-  }
-  eval '0 && $started; sub in_global_destruction () { $started && B::main_start()->isa(q[B::NULL]) }; 1'
+  eval 'sub in_global_destruction () { ${B::main_cv()} == 0 }; 1'
     or die $@;
 }
 
@@ -87,7 +81,7 @@ aliased, etc. if L<Sub::Exporter> is present.
 
 Returns true if the interpreter is in global destruction. In perl 5.14+, this
 returns C<${^GLOBAL_PHASE} eq 'DESTRUCT'>, and on earlier perls, detects it using
-the value of C<PL_main_start> or C<PL_dirty>.
+the value of C<PL_main_cv> or C<PL_dirty>.
 
 =back
 
diff --git a/t/06_load-in-gd.t b/t/06_load-in-gd.t
new file mode 100644
index 0000000..f51c401
--- /dev/null
+++ b/t/06_load-in-gd.t
@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+
+BEGIN {
+  if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) {
+    unshift @INC, sub {
+      die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm';
+    };
+  }
+}
+
+{
+  package Test::Scope::Guard;
+  sub new { my ($class, $code) = @_; bless [$code], $class; }
+  sub DESTROY { my $self = shift; $self->[0]->() }
+}
+
+print "1..1\n";
+
+our $alive = Test::Scope::Guard->new(sub {
+  require Devel::GlobalDestruction;
+  my $gd = Devel::GlobalDestruction::in_global_destruction();
+  print(($gd ? '' : 'not ') . "ok 1 - global destruct detected when loaded during GD\n");
+  exit($gd ? 0 : 1);
+});
+