Devel-GlobalDestruction-0.13HEADDevel-GlobalDestruction-0.13master

15 files changed, 960 insertions, 0 deletions

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..b71c3e6
--- /dev/null
+++ b/Changes
@@ -0,0 +1,54 @@
+
+0.13 - 2014-08-16
+  * include README
+  * include minimum perl version 5.6 in metadata
+
+0.12  Fri, 01 Nov 2013
+  * Fix detection when loaded during global destruction by checking B::main_cv
+    instead of B::main_start
+  * Bump Sub::Exporter::Progressive dependency to fix loading in global
+    destruction
+
+0.11  Wed, 03 Apr 2013
+  * Fix upgrading from version 0.09 or older
+
+0.10  Tue, 26 Mar 2013
+  * Rewrite pure-perl implementation in terms of B::main_start
+    (greatly simplifies code)
+  * Fix pure-perl behavior under $^C (RT#78619))
+  * Separate XS portion into a compiler-optional dependency
+    Devel::GlobalDestruction::XS
+
+0.09  Wed, 08 Aug 2012
+  * Rewrite completely broken pure-perl GD detection under threads
+  * Fix pure-perl implementation incorrectly reporting GD during END phase
+
+0.08  Tue, 31 Jul 2012
+  * Switch to Sub::Exporter::Progressive
+
+0.07  Wed, 25 Jul 2012
+  * Actually detect errors in pure-perl test
+  * Add prototype to pure-perl pre-5.14 version
+
+0.06  Thu, 14 Jun 2012
+  * De-retardize XS-less behavior under SpeedyCGI
+  * Test suite now works from within space-containing paths
+
+0.05  Thu, 26 Apr 2012
+  * Pure-perl implementation for situations where neither ${^GLOBAL_PHASE} nor
+    XS are available
+
+0.04  Sun, 03 Jul 2011 11:28:51 +0200
+  * To detect a perl with ${^GLOBAL_PHASE}, check for the feature itself instead
+    of a specific perl version (doy).
+  * Update the documentation to reflect the use of ${^GLOBAL_PHASE} if available
+    (doy).
+  * Stop depending on Scope::Guard for the tests (doy).
+  * Upgrade ppport.h from version 3.13 to 3.19.
+
+0.03
+  * Drop the XS code on perl versions recent enough to have ${^GLOBAL_PHASE}.
+  * Drop code to support perls older than 5.6.  We've always been depending on
+    5.6 anyway.
+    + Use XSLoader without a fallback to DynaLoader.
+    + Use our instead of use vars.
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..53368c2
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,15 @@
+Changes
+lib/Devel/GlobalDestruction.pm
+maint/Makefile.PL.include
+Makefile.PL
+MANIFEST			This list of files
+t/01_basic.t
+t/02_thread.t
+t/03_minusc.t
+t/04_phases.t
+t/05_thread_clone.t
+t/06_load-in-gd.t
+t/10_pure-perl.t
+META.yml                                 Module YAML meta-data (added by MakeMaker)
+META.json                                Module JSON meta-data (added by MakeMaker)
+README                                   README file (added by Distar)
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..8d6a393
--- /dev/null
+++ b/META.json
@@ -0,0 +1,61 @@
+{
+   "abstract" : "Provides function returning the equivalent of C<${^GLOBAL_PHASE} eq 'DESTRUCT'> for older perls.",
+   "author" : [
+      "Yuval Kogman <nothingmuch@woobling.org>",
+      "Florian Ragwitz <rafl@debian.org>",
+      "Jesse Luehrs <doy@tozt.net>",
+      "Peter Rabbitson <ribasushi@cpan.org>",
+      "Arthur Axel 'fREW' Schmidt <frioux@gmail.com>",
+      "Elizabeth Mattijsen <liz@dijkmat.nl>",
+      "Greham Knop <haarg@haarg.org>"
+   ],
+   "dynamic_config" : 1,
+   "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520",
+   "license" : [
+      "perl_5"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : "2"
+   },
+   "name" : "Devel-GlobalDestruction",
+   "no_index" : {
+      "directory" : [
+         "t",
+         "xt"
+      ]
+   },
+   "prereqs" : {
+      "build" : {},
+      "configure" : {
+         "requires" : {
+            "ExtUtils::CBuilder" : "0.27",
+            "ExtUtils::MakeMaker" : "0"
+         }
+      },
+      "runtime" : {
+         "requires" : {
+            "Sub::Exporter::Progressive" : "0.001011",
+            "perl" : "5.006"
+         }
+      },
+      "test" : {}
+   },
+   "release_status" : "stable",
+   "resources" : {
+      "bugtracker" : {
+         "mailto" : "bug-Devel-GlobalDestruction@rt.cpan.org",
+         "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-GlobalDestruction"
+      },
+      "homepage" : "https://metacpan.org/release/Devel-GlobalDestruction",
+      "license" : [
+         "http://dev.perl.org/licenses/"
+      ],
+      "repository" : {
+         "type" : "git",
+         "url" : "git://git.shadowcat.co.uk/p5sagit/Devel-GlobalDestruction.git",
+         "web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/Devel-GlobalDestruction.git"
+      }
+   },
+   "version" : "0.13"
+}
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..280be38
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,34 @@
+---
+abstract: "Provides function returning the equivalent of C<${^GLOBAL_PHASE} eq 'DESTRUCT'> for older perls."
+author:
+  - 'Yuval Kogman <nothingmuch@woobling.org>'
+  - 'Florian Ragwitz <rafl@debian.org>'
+  - 'Jesse Luehrs <doy@tozt.net>'
+  - 'Peter Rabbitson <ribasushi@cpan.org>'
+  - "Arthur Axel 'fREW' Schmidt <frioux@gmail.com>"
+  - 'Elizabeth Mattijsen <liz@dijkmat.nl>'
+  - 'Greham Knop <haarg@haarg.org>'
+build_requires: {}
+configure_requires:
+  ExtUtils::CBuilder: '0.27'
+  ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520'
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: '1.4'
+name: Devel-GlobalDestruction
+no_index:
+  directory:
+    - t
+    - xt
+requires:
+  Sub::Exporter::Progressive: '0.001011'
+  perl: '5.006'
+resources:
+  bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-GlobalDestruction
+  homepage: https://metacpan.org/release/Devel-GlobalDestruction
+  license: http://dev.perl.org/licenses/
+  repository: git://git.shadowcat.co.uk/p5sagit/Devel-GlobalDestruction.git
+version: '0.13'
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..aaf3c41
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,227 @@
+use strict;
+use warnings FATAL => 'all';
+use 5.006;
+
+my %META = (
+  name => 'Devel-GlobalDestruction',
+  license => 'perl_5',
+  prereqs => {
+    configure => { requires => {
+      'ExtUtils::MakeMaker'   => 0,
+      'ExtUtils::CBuilder'    => 0.27,
+    } },
+    runtime => {
+      requires => {
+        'Sub::Exporter::Progressive' => '0.001011',
+        'perl'                      => 5.006,
+      },
+    },
+  },
+  resources => {
+    homepage => 'https://metacpan.org/release/Devel-GlobalDestruction',
+    repository => {
+      url => 'git://git.shadowcat.co.uk/p5sagit/Devel-GlobalDestruction.git',
+      web => 'http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/Devel-GlobalDestruction.git',
+      type => 'git',
+    },
+    bugtracker => {
+      web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-GlobalDestruction',
+      mailto => 'bug-Devel-GlobalDestruction@rt.cpan.org',
+    },
+    license => [ 'http://dev.perl.org/licenses/' ],
+  },
+  no_index => {
+    directory => [ 't', 'xt' ]
+  },
+);
+
+my %MM_ARGS = (
+  PREREQ_PM => {
+    ( (defined ${^GLOBAL_PHASE} or parse_args()->{PUREPERL_ONLY} or !can_xs() )
+      ? ()
+      : ('Devel::GlobalDestruction::XS' => 0)
+    ),
+  },
+);
+
+use ExtUtils::MakeMaker;
+BEGIN { if ( $^O eq 'cygwin' ) {
+  require ExtUtils::MM_Cygwin;
+  require ExtUtils::MM_Win32;
+  if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
+    *ExtUtils::MM_Cygwin::maybe_command = sub {
+      my ($self, $file) = @_;
+      if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
+        ExtUtils::MM_Win32->maybe_command($file);
+      } else {
+        ExtUtils::MM_Unix->maybe_command($file);
+      }
+    }
+  }
+}}
+
+use Text::ParseWords;
+
+sub parse_args {
+  # copied from EUMM
+  ExtUtils::MakeMaker::parse_args(
+    my $tmp = {},
+    Text::ParseWords::shellwords($ENV{PERL_MM_OPT} || ''),
+    @ARGV,
+  );
+  return $tmp->{ARGS} || {};
+}
+
+if (eval { require Devel::GlobalDestruction }
+    && Devel::GlobalDestruction->VERSION < 0.10) {
+  package MY;
+  no warnings 'once';
+
+  *install = sub {
+    my $self = shift;
+    return '
+pure_site_install ::
+	$(NOECHO) $(RM_F) ' . $self->quote_literal(
+      $self->catfile('$(DESTINSTALLSITEARCH)', 'Devel', 'GlobalDestruction.pm')
+    ) . "\n" . $self->SUPER::install;
+  };
+}
+
+# can we locate a (the) C compiler
+sub can_cc {
+  my @chunks = split(/ /, $Config::Config{cc}) or return;
+
+  # $Config{cc} may contain args; try to find out the program part
+  while (@chunks) {
+    return can_run("@chunks") || (pop(@chunks), next);
+  }
+
+  return;
+}
+
+# check if we can run some command
+sub can_run {
+  my ($cmd) = @_;
+
+  return $cmd if -x $cmd;
+  if (my $found_cmd = MM->maybe_command($cmd)) {
+    return $found_cmd;
+  }
+
+  require File::Spec;
+  for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+    next if $dir eq '';
+    my $abs = File::Spec->catfile($dir, $cmd);
+    return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+  }
+
+  return;
+}
+
+# Can our C compiler environment build XS files
+sub can_xs {
+  # Do we have the configure_requires checker?
+  local $@;
+  eval "require ExtUtils::CBuilder; ExtUtils::CBuilder->VERSION(0.27)";
+  if ( $@ ) {
+    # They don't obey configure_requires, so it is
+    # someone old and delicate. Try to avoid hurting
+    # them by falling back to an older simpler test.
+    return can_cc();
+  }
+
+  # Do we have a working C compiler
+  my $builder = ExtUtils::CBuilder->new(
+    quiet => 1,
+  );
+  unless ( $builder->have_compiler ) {
+    # No working C compiler
+    return 0;
+  }
+
+  # Write a C file representative of what XS becomes
+  require File::Temp;
+  my ( $FH, $tmpfile ) = File::Temp::tempfile(
+    "compilexs-XXXXX",
+    SUFFIX => '.c',
+  );
+  binmode $FH;
+  print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+    return 0;
+}
+
+int boot_sanexs() {
+    return 1;
+}
+
+END_C
+  close $FH;
+
+  # Can the C compiler access the same headers XS does
+  my @libs   = ();
+  my $object = undef;
+  eval {
+    local $^W = 0;
+    $object = $builder->compile(
+      source => $tmpfile,
+    );
+    @libs = $builder->link(
+      objects     => $object,
+      module_name => 'sanexs',
+    );
+  };
+  my $result = $@ ? 0 : 1;
+
+  # Clean up all the build files
+  foreach ( $tmpfile, $object, @libs ) {
+    next unless defined $_;
+    1 while unlink;
+  }
+
+  return $result;
+}
+
+##############################################################################
+require ExtUtils::MakeMaker;
+(do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml';
+
+# have to do this since old EUMM dev releases miss the eval $VERSION line
+my $eumm_version  = eval $ExtUtils::MakeMaker::VERSION;
+my $mymeta        = $eumm_version >= 6.57_02;
+my $mymeta_broken = $mymeta && $eumm_version < 6.57_07;
+
+($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g;
+($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g;
+$MM_ARGS{LICENSE} = $META{license}
+  if $eumm_version >= 6.30;
+$MM_ARGS{NO_MYMETA} = 1
+  if $mymeta_broken;
+$MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META }
+  unless -f 'META.yml';
+
+for (qw(configure build test runtime)) {
+  my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES';
+  my $r = $MM_ARGS{$key} = {
+    %{$META{prereqs}{$_}{requires} || {}},
+    %{delete $MM_ARGS{$key} || {}},
+  };
+  defined $r->{$_} or delete $r->{$_} for keys %$r;
+}
+
+$MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0;
+
+delete $MM_ARGS{MIN_PERL_VERSION}
+  if $eumm_version < 6.47_01;
+$MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}}
+  if $eumm_version < 6.63_03;
+$MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}}
+  if $eumm_version < 6.55_01;
+delete $MM_ARGS{CONFIGURE_REQUIRES}
+  if $eumm_version < 6.51_03;
+
+ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS);
diff --git a/README b/README
new file mode 100644
index 0000000..d6114b1
--- /dev/null
+++ b/README
@@ -0,0 +1,56 @@
+NAME
+    Devel::GlobalDestruction - Provides function returning the equivalent of
+    "${^GLOBAL_PHASE} eq 'DESTRUCT'" for older perls.
+
+SYNOPSIS
+        package Foo;
+        use Devel::GlobalDestruction;
+
+        use namespace::clean; # to avoid having an "in_global_destruction" method
+
+        sub DESTROY {
+            return if in_global_destruction;
+
+            do_something_a_little_tricky();
+        }
+
+DESCRIPTION
+    Perl's global destruction is a little tricky to deal with WRT finalizers
+    because it's not ordered and objects can sometimes disappear.
+
+    Writing defensive destructors is hard and annoying, and usually if
+    global destruction is happening you only need the destructors that free
+    up non process local resources to actually execute.
+
+    For these constructors you can avoid the mess by simply bailing out if
+    global destruction is in effect.
+
+EXPORTS
+    This module uses Sub::Exporter::Progressive so the exports may be
+    renamed, aliased, etc. if Sub::Exporter is present.
+
+    in_global_destruction
+        Returns true if the interpreter is in global destruction. In perl
+        5.14+, this returns "${^GLOBAL_PHASE} eq 'DESTRUCT'", and on earlier
+        perls, detects it using the value of "PL_main_cv" or "PL_dirty".
+
+AUTHORS
+    Yuval Kogman <nothingmuch@woobling.org>
+
+    Florian Ragwitz <rafl@debian.org>
+
+    Jesse Luehrs <doy@tozt.net>
+
+    Peter Rabbitson <ribasushi@cpan.org>
+
+    Arthur Axel 'fREW' Schmidt <frioux@gmail.com>
+
+    Elizabeth Mattijsen <liz@dijkmat.nl>
+
+    Greham Knop <haarg@haarg.org>
+
+COPYRIGHT
+        Copyright (c) 2008 Yuval Kogman. All rights reserved
+        This program is free software; you can redistribute
+        it and/or modify it under the same terms as Perl itself.
+
diff --git a/lib/Devel/GlobalDestruction.pm b/lib/Devel/GlobalDestruction.pm
new file mode 100644
index 0000000..b449cda
--- /dev/null
+++ b/lib/Devel/GlobalDestruction.pm
@@ -0,0 +1,110 @@
+package Devel::GlobalDestruction;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.13';
+
+use Sub::Exporter::Progressive -setup => {
+  exports => [ qw(in_global_destruction) ],
+  groups  => { default => [ -all ] },
+};
+
+# we run 5.14+ - everything is in core
+#
+if (defined ${^GLOBAL_PHASE}) {
+  eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }; 1'
+    or die $@;
+}
+# try to load the xs version if it was compiled
+#
+elsif (eval {
+  require Devel::GlobalDestruction::XS;
+  no warnings 'once';
+  *in_global_destruction = \&Devel::GlobalDestruction::XS::in_global_destruction;
+  1;
+}) {
+  # the eval already installed everything, nothing to do
+}
+else {
+  # 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;
+  eval 'sub in_global_destruction () { ${B::main_cv()} == 0 }; 1'
+    or die $@;
+}
+
+1;  # keep require happy
+
+
+__END__
+
+=head1 NAME
+
+Devel::GlobalDestruction - Provides function returning the equivalent of
+C<${^GLOBAL_PHASE} eq 'DESTRUCT'> for older perls.
+
+=head1 SYNOPSIS
+
+    package Foo;
+    use Devel::GlobalDestruction;
+
+    use namespace::clean; # to avoid having an "in_global_destruction" method
+
+    sub DESTROY {
+        return if in_global_destruction;
+
+        do_something_a_little_tricky();
+    }
+
+=head1 DESCRIPTION
+
+Perl's global destruction is a little tricky to deal with WRT finalizers
+because it's not ordered and objects can sometimes disappear.
+
+Writing defensive destructors is hard and annoying, and usually if global
+destruction is happening you only need the destructors that free up non
+process local resources to actually execute.
+
+For these constructors you can avoid the mess by simply bailing out if global
+destruction is in effect.
+
+=head1 EXPORTS
+
+This module uses L<Sub::Exporter::Progressive> so the exports may be renamed,
+aliased, etc. if L<Sub::Exporter> is present.
+
+=over 4
+
+=item in_global_destruction
+
+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_cv> or C<PL_dirty>.
+
+=back
+
+=head1 AUTHORS
+
+Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
+
+Florian Ragwitz E<lt>rafl@debian.orgE<gt>
+
+Jesse Luehrs E<lt>doy@tozt.netE<gt>
+
+Peter Rabbitson E<lt>ribasushi@cpan.orgE<gt>
+
+Arthur Axel 'fREW' Schmidt E<lt>frioux@gmail.comE<gt>
+
+Elizabeth Mattijsen E<lt>liz@dijkmat.nlE<gt>
+
+Greham Knop E<lt>haarg@haarg.orgE<gt>
+
+=head1 COPYRIGHT
+
+    Copyright (c) 2008 Yuval Kogman. All rights reserved
+    This program is free software; you can redistribute
+    it and/or modify it under the same terms as Perl itself.
+
+=cut
diff --git a/maint/Makefile.PL.include b/maint/Makefile.PL.include
new file mode 100644
index 0000000..63f296a
--- /dev/null
+++ b/maint/Makefile.PL.include
@@ -0,0 +1,17 @@
+BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") }
+use lib 'Distar/lib';
+use Distar 0.001;
+
+use ExtUtils::MakeMaker 6.57_10 ();
+
+author [
+  'Yuval Kogman <nothingmuch@woobling.org>',
+  'Florian Ragwitz <rafl@debian.org>',
+  'Jesse Luehrs <doy@tozt.net>',
+  'Peter Rabbitson <ribasushi@cpan.org>',
+  'Arthur Axel \'fREW\' Schmidt <frioux@gmail.com>',
+  'Elizabeth Mattijsen <liz@dijkmat.nl>',
+  'Greham Knop <haarg@haarg.org>',
+];
+
+1;
diff --git a/t/01_basic.t b/t/01_basic.t
new file mode 100644
index 0000000..c8d847f
--- /dev/null
+++ b/t/01_basic.t
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+
+BEGIN {
+  if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) {
+    unshift @INC, sub {
+      die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm';
+    };
+  }
+}
+
+BEGIN {
+  package Test::Scope::Guard;
+  sub new { my ($class, $code) = @_; bless [$code], $class; }
+  sub DESTROY { my $self = shift; $self->[0]->() }
+}
+
+print "1..9\n";
+
+our $had_error;
+
+# try to ensure this is the last-most END so we capture future tests
+# running in other ENDs
+if ($] >= 5.008) {
+  require B;
+  my $reinject_retries = my $max_retry = 5;
+  my $end_worker;
+  $end_worker = sub {
+    my $tail = (B::end_av()->ARRAY)[-1];
+    if (!defined $tail or $tail == $end_worker) {
+      $? = $had_error || 0;
+      $reinject_retries = 0;
+    }
+    elsif ($reinject_retries--) {
+      push @{B::end_av()->object_2svref}, $end_worker;
+    }
+    else {
+      print STDERR "\n\nSomething is racing with @{[__FILE__]} for final END block definition - can't win after $max_retry iterations :(\n\n";
+      require POSIX;
+      POSIX::_exit( 255 );
+    }
+  };
+  eval 'END { push @{B::end_av()->object_2svref}, $end_worker }';
+}
+# B::end_av isn't available on 5.6, so just use a basic end block
+else {
+  eval 'END { $? = $had_error || 0 }';
+}
+
+sub ok ($$) {
+  $had_error++, print "not " if !$_[0];
+  print "ok";
+  print " - $_[1]" if defined $_[1];
+  print "\n";
+}
+
+END {
+  ok( ! in_global_destruction(), 'Not yet in GD while in END block 2' )
+}
+
+ok( eval "use Devel::GlobalDestruction; 1", "use Devel::GlobalDestruction" );
+
+ok( defined &in_global_destruction, "exported" );
+
+ok( defined prototype \&in_global_destruction, "defined prototype" );
+
+ok( prototype \&in_global_destruction eq "", "empty prototype" );
+
+ok( ! in_global_destruction(), "Runtime is not GD" );
+
+our $sg1;
+$sg1 = Test::Scope::Guard->new(sub { ok( in_global_destruction(), "Final cleanup object destruction properly in GD" ) });
+
+END {
+  ok( ! in_global_destruction(), 'Not yet in GD while in END block 1' )
+}
+
+our $sg2 = Test::Scope::Guard->new(sub { ok( ! in_global_destruction(), "Object destruction in END not considered GD" ) });
+END { undef $sg2 }
diff --git a/t/02_thread.t b/t/02_thread.t
new file mode 100644
index 0000000..4a7b6d0
--- /dev/null
+++ b/t/02_thread.t
@@ -0,0 +1,51 @@
+use Config;
+BEGIN {
+  unless ($Config{useithreads}) {
+    print "1..0 # SKIP your perl does not support ithreads\n";
+    exit 0;
+  }
+}
+
+BEGIN {
+  unless (eval { require threads }) {
+    print "1..0 # SKIP threads.pm not installed\n";
+    exit 0;
+  }
+}
+
+use threads;
+use threads::shared;
+
+our $had_error :shared;
+END { $? = $had_error||0 }
+
+use strict;
+use warnings;
+
+BEGIN {
+  if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) {
+    unshift @INC, sub {
+      die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm';
+    };
+  }
+}
+
+# load it before spawning a thread, that's the whole point
+require Devel::GlobalDestruction;
+
+sub do_test {
+
+  # just die so we don't need to deal with testcount skew
+  unless ( ($_[0]||'') eq 'arg' ) {
+    $had_error++;
+    die "Argument passing failed!";
+  }
+
+  delete $INC{'t/01_basic.t'};
+  do 't/01_basic.t';
+
+  1;
+}
+
+threads->create('do_test', 'arg')->join
+  or $had_error++;
diff --git a/t/03_minusc.t b/t/03_minusc.t
new file mode 100644
index 0000000..0bb43ff
--- /dev/null
+++ b/t/03_minusc.t
@@ -0,0 +1,48 @@
+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]->() }
+}
+
+sub ok ($$) {
+  print "not " if !$_[0];
+  print "ok";
+  print " - $_[1]" if defined $_[1];
+  print "\n";
+  !!$_[0]
+}
+
+BEGIN {
+  require B;
+  B::minus_c();
+
+  print "1..3\n";
+  ok( $^C, "Test properly running under minus-c" );
+}
+
+use Devel::GlobalDestruction;
+
+BEGIN {
+    ok !in_global_destruction(), "BEGIN is not GD with -c";
+}
+
+our $foo;
+BEGIN {
+  $foo = Test::Scope::Guard->new( sub {
+    ok( in_global_destruction(), "Final cleanup object destruction properly in GD" ) or do {
+      require POSIX;
+      POSIX::_exit(1);
+    };
+  });
+}
diff --git a/t/04_phases.t b/t/04_phases.t
new file mode 100644
index 0000000..db54492
--- /dev/null
+++ b/t/04_phases.t
@@ -0,0 +1,57 @@
+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]->() }
+}
+
+my $had_error = 0;
+END { $? = $had_error }
+sub ok ($$) {
+  $had_error++, print "not " if !$_[0];
+  print "ok";
+  print " - $_[1]" if defined $_[1];
+  print "\n";
+  !!$_[0]
+}
+
+use Devel::GlobalDestruction;
+
+sub check_not_global {
+  my $phase = shift;
+  ok !in_global_destruction(), "$phase is not GD";
+  Test::Scope::Guard->new( sub {
+    ok( !in_global_destruction(), "DESTROY in $phase still not GD" );
+  });
+}
+
+BEGIN {
+  print "1..10\n";
+}
+
+BEGIN { check_not_global('BEGIN') }
+
+BEGIN {
+  if (eval 'UNITCHECK {}; 1') {
+    eval q[ UNITCHECK { check_not_global('UNITCHECK') }; 1 ]
+      or die $@;
+  }
+  else {
+    print "ok # UNITCHECK not supported in perl < 5.10\n" x 2;
+  }
+}
+
+CHECK { check_not_global('CHECK') }
+sub CLONE { check_not_global('CLONE') };
+INIT { check_not_global('INIT') }
+END { check_not_global('END') }
diff --git a/t/05_thread_clone.t b/t/05_thread_clone.t
new file mode 100644
index 0000000..f2c939f
--- /dev/null
+++ b/t/05_thread_clone.t
@@ -0,0 +1,78 @@
+use strict;
+use warnings;
+
+use Config;
+BEGIN {
+  unless ($Config{useithreads}) {
+    print "1..0 # SKIP your perl does not support ithreads\n";
+    exit 0;
+  }
+}
+
+BEGIN {
+  unless (eval { require threads }) {
+    print "1..0 # SKIP threads.pm not installed\n";
+    exit 0;
+  }
+}
+
+BEGIN {
+  if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) {
+    unshift @INC, sub {
+      die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm';
+    };
+  }
+}
+
+BEGIN {
+  package Test::Scope::Guard;
+  sub new { my ($class, $code) = @_; bless [$code], $class; }
+  sub DESTROY { my $self = shift; $self->[0]->() }
+}
+BEGIN {
+  package Test::Thread::Clone;
+  my @code;
+  sub new { my ($class, $code) = @_; push @code, $code; bless [$code], $class; }
+  sub CLONE { $_->() for @code }
+}
+
+use threads;
+use threads::shared;
+
+print "1..4\n";
+
+our $had_error :shared;
+END { $? = $had_error||0 }
+
+sub ok ($$) {
+  $had_error++, print "not " if !$_[0];
+  print "ok";
+  print " - $_[1]" if defined $_[1];
+  print "\n";
+}
+
+# load it before spawning a thread, that's the whole point
+use Devel::GlobalDestruction;
+
+our $cloner = Test::Thread::Clone->new(sub {
+    ok( ! in_global_destruction(), "CLONE is not GD" );
+    my $guard = Test::Scope::Guard->new(sub {
+        ok( ! in_global_destruction(), "DESTROY during CLONE is not GD");
+    });
+});
+our $global = Test::Scope::Guard->new(sub {
+    ok( in_global_destruction(), "Final cleanup object destruction properly in GD in " . (threads->tid ? 'thread' : 'main program') );
+});
+
+sub do_test {
+  # just die so we don't need to deal with testcount skew
+  unless ( ($_[0]||'') eq 'arg' ) {
+    $had_error++;
+    die "Argument passing failed!";
+  }
+  # nothing really to do in here
+  1;
+}
+
+threads->create('do_test', 'arg')->join
+  or $had_error++;
diff --git a/t/06_load-in-gd.t b/t/06_load-in-gd.t
new file mode 100644
index 0000000..574c29d
--- /dev/null
+++ b/t/06_load-in-gd.t
@@ -0,0 +1,33 @@
+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]->() }
+}
+
+use POSIX qw(_exit);
+
+$|++;
+print "1..3\n";
+
+our $alive = Test::Scope::Guard->new(sub {
+  require Devel::GlobalDestruction;
+  my $gd = Devel::GlobalDestruction::in_global_destruction();
+  print(($gd ? '' : 'not ') . "ok 3 - global destruct detected when loaded during GD\n");
+  _exit($gd ? 0 : 1);
+});
+
+print(($alive ? '' : 'not ') . "ok 1 - alive during runtime\n");
+END {
+  print(($alive ? '' : 'not ') . "ok 2 - alive during END\n");
+}
diff --git a/t/10_pure-perl.t b/t/10_pure-perl.t
new file mode 100644
index 0000000..3246c03
--- /dev/null
+++ b/t/10_pure-perl.t
@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+use FindBin qw($Bin);
+use Config;
+use IPC::Open2;
+
+# rerun the tests under the assumption of pure-perl
+
+# for the $^X-es
+$ENV{PERL5LIB} = join ($Config{path_sep}, @INC);
+$ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST} = 1;
+
+my $this_file = quotemeta(__FILE__);
+
+opendir(my $dh, $Bin);
+my @tests = grep { $_ !~ /${this_file}$/ } map { "$Bin/$_" } grep { /\.t$/ } readdir $dh;
+print "1..@{[ scalar @tests ]}\n";
+
+my $had_error = 0;
+END { $? = $had_error }
+sub ok ($$) {
+  $had_error++, print "not " if !$_[0];
+  print "ok";
+  print " - $_[1]" if defined $_[1];
+  print "\n";
+}
+
+for my $fn (@tests) {
+  # this is cheating, and may even hang here and there (testing on windows passed fine)
+  # if it does - will have to fix it somehow (really *REALLY* don't want to pull
+  # in IPC::Cmd just for a fucking test)
+  # the alternative would be to have an ENV check in each test to force a subtest
+  open2(my $out, my $in, $^X, $fn );
+  while (my $ln = <$out>) {
+    print "   $ln";
+  }
+
+  wait;
+  ok (! $?, "Exit $? from: $^X $fn");
+}