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