Commit | Line | Data |
101e5667 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | BEGIN { |
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 | print "1..8\n"; |
11 | |
12 | our $had_error; |
13 | |
14 | # try to ensure this is the last-most END so we capture future tests |
15 | # running in other ENDs |
16 | require B; |
17 | my $reinject_retries = my $max_retry = 5; |
18 | my $end_worker; |
19 | $end_worker = sub { |
20 | my $tail = (B::end_av()->ARRAY)[-1]; |
21 | if (!defined $tail or $tail == $end_worker) { |
22 | $? = $had_error || 0; |
23 | $reinject_retries = 0; |
24 | } |
25 | elsif ($reinject_retries--) { |
26 | push @{B::end_av()->object_2svref}, $end_worker; |
27 | } |
28 | else { |
29 | print STDERR "\n\nSomething is racing with @{[__FILE__]} for final END block definition - can't win after $max_retry iterations :(\n\n"; |
30 | require POSIX; |
31 | POSIX::_exit( 255 ); |
32 | } |
33 | }; |
34 | END { push @{B::end_av()->object_2svref}, $end_worker } |
35 | |
36 | sub ok ($$) { |
37 | $had_error++, print "not " if !$_[0]; |
38 | print "ok"; |
39 | print " - $_[1]" if defined $_[1]; |
40 | print "\n"; |
41 | } |
42 | |
43 | END { |
44 | ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), 'Not yet in GD while in END block 2' ) |
45 | } |
46 | |
47 | ok( eval "use Devel::GlobalDestruction::XS; 1", "use Devel::GlobalDestruction::XS" ); |
48 | |
49 | ok( defined prototype \&Devel::GlobalDestruction::XS::in_global_destruction, "defined prototype" ); |
50 | |
51 | ok( prototype \&Devel::GlobalDestruction::XS::in_global_destruction eq "", "empty prototype" ); |
52 | |
53 | ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), "Runtime is not GD" ); |
54 | |
55 | our $sg1 = Test::Scope::Guard->new(sub { ok( Devel::GlobalDestruction::XS::in_global_destruction(), "Final cleanup object destruction properly in GD" ) }); |
56 | |
57 | END { |
58 | ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), 'Not yet in GD while in END block 1' ) |
59 | } |
60 | |
61 | our $sg2 = Test::Scope::Guard->new(sub { ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), "Object destruction in END not considered GD" ) }); |
62 | END { undef $sg2 } |