Commit | Line | Data |
a91e8a78 |
1 | use strict; |
2 | use warnings; |
3 | |
9aaf3646 |
4 | BEGIN { |
53daa838 |
5 | if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) { |
82ca1dd8 |
6 | no strict 'refs'; |
53daa838 |
7 | no warnings 'redefine'; |
82ca1dd8 |
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 | } |
53daa838 |
19 | } |
9aaf3646 |
20 | } |
a91e8a78 |
21 | |
38d57e49 |
22 | BEGIN { |
53daa838 |
23 | package Test::Scope::Guard; |
24 | sub new { my ($class, $code) = @_; bless [$code], $class; } |
25 | sub DESTROY { my $self = shift; $self->[0]->() } |
38d57e49 |
26 | } |
a91e8a78 |
27 | |
140a3884 |
28 | print "1..9\n"; |
a91e8a78 |
29 | |
5197ed54 |
30 | our $had_error; |
31 | |
32 | # try to ensure this is the last-most END so we capture future tests |
33 | # running in other ENDs |
34 | require B; |
35 | my $reinject_retries = my $max_retry = 5; |
36 | my $end_worker; |
37 | $end_worker = sub { |
38 | my $tail = (B::end_av()->ARRAY)[-1]; |
39 | if (!defined $tail or $tail == $end_worker) { |
40 | $? = $had_error || 0; |
41 | $reinject_retries = 0; |
42 | } |
43 | elsif ($reinject_retries--) { |
44 | push @{B::end_av()->object_2svref}, $end_worker; |
45 | } |
46 | else { |
47 | print STDERR "\n\nSomething is racing with @{[__FILE__]} for final END block definition - can't win after $max_retry iterations :(\n\n"; |
48 | require POSIX; |
49 | POSIX::_exit( 255 ); |
50 | } |
51 | }; |
52 | END { push @{B::end_av()->object_2svref}, $end_worker } |
53 | |
a91e8a78 |
54 | sub ok ($$) { |
53daa838 |
55 | $had_error++, print "not " if !$_[0]; |
56 | print "ok"; |
57 | print " - $_[1]" if defined $_[1]; |
58 | print "\n"; |
a91e8a78 |
59 | } |
60 | |
140a3884 |
61 | END { |
62 | ok( ! in_global_destruction(), 'Not yet in GD while in END block 2' ) |
63 | } |
64 | |
a91e8a78 |
65 | ok( eval "use Devel::GlobalDestruction; 1", "use Devel::GlobalDestruction" ); |
66 | |
67 | ok( defined &in_global_destruction, "exported" ); |
68 | |
41ec1eaf |
69 | ok( defined prototype \&in_global_destruction, "defined prototype" ); |
70 | |
71 | ok( prototype \&in_global_destruction eq "", "empty prototype" ); |
72 | |
140a3884 |
73 | ok( ! in_global_destruction(), "Runtime is not GD" ); |
74 | |
75 | our $sg1 = Test::Scope::Guard->new(sub { ok( in_global_destruction(), "Final cleanup object destruction properly in GD" ) }); |
76 | |
77 | END { |
78 | ok( ! in_global_destruction(), 'Not yet in GD while in END block 1' ) |
79 | } |
a91e8a78 |
80 | |
140a3884 |
81 | our $sg2 = Test::Scope::Guard->new(sub { ok( ! in_global_destruction(), "Object destruction in END not considered GD" ) }); |
82 | END { undef $sg2 } |