Commit | Line | Data |
101e5667 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | { |
5 | package Test::Scope::Guard; |
6 | sub new { my ($class, $code) = @_; bless [$code], $class; } |
7 | sub DESTROY { my $self = shift; $self->[0]->() } |
8 | } |
9 | |
10 | my $had_error = 0; |
11 | END { $? = $had_error } |
12 | sub ok ($$) { |
13 | $had_error++, print "not " if !$_[0]; |
14 | print "ok"; |
15 | print " - $_[1]" if defined $_[1]; |
16 | print "\n"; |
17 | !!$_[0] |
18 | } |
19 | |
20 | use Devel::GlobalDestruction::XS; |
21 | |
22 | sub check_not_global { |
23 | my $phase = shift; |
24 | ok !Devel::GlobalDestruction::XS::in_global_destruction(), "$phase is not GD"; |
25 | Test::Scope::Guard->new( sub { |
26 | ok( !Devel::GlobalDestruction::XS::in_global_destruction(), "DESTROY in $phase still not GD" ); |
27 | }); |
28 | } |
29 | |
30 | BEGIN { |
31 | print "1..10\n"; |
32 | } |
33 | |
34 | BEGIN { check_not_global('BEGIN') } |
35 | |
36 | BEGIN { |
37 | if (eval 'UNITCHECK {}; 1') { |
38 | eval q[ UNITCHECK { check_not_global('UNITCHECK') }; 1 ] |
39 | or die $@; |
40 | } |
41 | else { |
42 | print "ok # UNITCHECK not supported in perl < 5.10\n" x 2; |
43 | } |
44 | } |
45 | |
46 | CHECK { check_not_global('CHECK') } |
47 | sub CLONE { check_not_global('CLONE') }; |
48 | INIT { check_not_global('INIT') } |
49 | END { check_not_global('END') } |