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