5 if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) {
7 no warnings 'redefine';
9 for my $f (qw(DynaLoader::bootstrap XSLoader::load)) {
10 my ($mod) = $f =~ /^ (.+) \:\: [^:]+ $/x;
11 eval "require $mod" or die $@;
15 die 'no XS' if ($_[0]||'') eq 'Devel::GlobalDestruction';
23 package Test::Scope::Guard;
24 sub new { my ($class, $code) = @_; bless [$code], $class; }
25 sub DESTROY { my $self = shift; $self->[0]->() }
29 END { $? = $had_error }
31 $had_error++, print "not " if !$_[0];
33 print " - $_[1]" if defined $_[1];
38 use Devel::GlobalDestruction;
40 sub check_not_global {
42 ok !in_global_destruction(), "$phase is not GD";
43 Test::Scope::Guard->new( sub {
44 ok( !in_global_destruction(), "DESTROY in $phase still not GD" );
52 BEGIN { check_not_global('BEGIN') }
55 if (eval 'UNITCHECK {}; 1') {
56 eval q[ UNITCHECK { check_not_global('UNITCHECK') }; 1 ]
60 print "ok # UNITCHECK not supported in perl < 5.10\n" x 2;
64 CHECK { check_not_global('CHECK') }
65 sub CLONE { check_not_global('CLONE') };
66 INIT { check_not_global('INIT') }
67 END { check_not_global('END') }