Commit | Line | Data |
5629eb97 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | BEGIN { |
5 | if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) { |
6 | no strict 'refs'; |
7 | no warnings 'redefine'; |
8 | |
9 | for my $f (qw(DynaLoader::bootstrap XSLoader::load)) { |
10 | my ($mod) = $f =~ /^ (.+) \:\: [^:]+ $/x; |
11 | eval "require $mod" or die $@; |
12 | |
13 | my $orig = \&$f; |
14 | *$f = sub { |
15 | die 'no XS' if ($_[0]||'') eq 'Devel::GlobalDestruction'; |
16 | goto $orig; |
17 | }; |
18 | } |
19 | } |
20 | } |
21 | |
22 | { |
23 | package Test::Scope::Guard; |
24 | sub new { my ($class, $code) = @_; bless [$code], $class; } |
25 | sub DESTROY { my $self = shift; $self->[0]->() } |
26 | } |
27 | |
649cae51 |
28 | my $had_error = 0; |
29 | END { $? = $had_error } |
5629eb97 |
30 | sub ok ($$) { |
649cae51 |
31 | $had_error++, print "not " if !$_[0]; |
5629eb97 |
32 | print "ok"; |
33 | print " - $_[1]" if defined $_[1]; |
34 | print "\n"; |
35 | !!$_[0] |
36 | } |
37 | |
38 | use Devel::GlobalDestruction; |
39 | |
649cae51 |
40 | sub check_not_global { |
41 | my $phase = shift; |
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" ); |
5629eb97 |
45 | }); |
46 | } |
47 | |
649cae51 |
48 | BEGIN { |
49 | print "1..10\n"; |
50 | } |
51 | |
52 | BEGIN { check_not_global('BEGIN') } |
53 | |
54 | BEGIN { |
55 | if (eval 'UNITCHECK {}; 1') { |
56 | eval q[ UNITCHECK { check_not_global('UNITCHECK') }; 1 ] |
57 | or die $@; |
58 | } |
59 | else { |
60 | print "ok # UNITCHECK not supported in perl < 5.10\n" x 2; |
61 | } |
62 | } |
63 | |
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') } |