Commit | Line | Data |
a91e8a78 |
1 | use strict; |
2 | use warnings; |
3 | |
9aaf3646 |
4 | BEGIN { |
53daa838 |
5 | if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) { |
6 | require DynaLoader; |
7 | no warnings 'redefine'; |
8 | my $orig = \&DynaLoader::bootstrap; |
9 | *DynaLoader::bootstrap = sub { |
10 | die 'no XS' if $_[0] eq 'Devel::GlobalDestruction'; |
11 | goto $orig; |
12 | }; |
13 | } |
9aaf3646 |
14 | } |
a91e8a78 |
15 | |
38d57e49 |
16 | BEGIN { |
53daa838 |
17 | package Test::Scope::Guard; |
18 | sub new { my ($class, $code) = @_; bless [$code], $class; } |
19 | sub DESTROY { my $self = shift; $self->[0]->() } |
38d57e49 |
20 | } |
a91e8a78 |
21 | |
41ec1eaf |
22 | print "1..6\n"; |
a91e8a78 |
23 | |
5197ed54 |
24 | our $had_error; |
25 | |
26 | # try to ensure this is the last-most END so we capture future tests |
27 | # running in other ENDs |
28 | require B; |
29 | my $reinject_retries = my $max_retry = 5; |
30 | my $end_worker; |
31 | $end_worker = sub { |
32 | my $tail = (B::end_av()->ARRAY)[-1]; |
33 | if (!defined $tail or $tail == $end_worker) { |
34 | $? = $had_error || 0; |
35 | $reinject_retries = 0; |
36 | } |
37 | elsif ($reinject_retries--) { |
38 | push @{B::end_av()->object_2svref}, $end_worker; |
39 | } |
40 | else { |
41 | print STDERR "\n\nSomething is racing with @{[__FILE__]} for final END block definition - can't win after $max_retry iterations :(\n\n"; |
42 | require POSIX; |
43 | POSIX::_exit( 255 ); |
44 | } |
45 | }; |
46 | END { push @{B::end_av()->object_2svref}, $end_worker } |
47 | |
a91e8a78 |
48 | sub ok ($$) { |
53daa838 |
49 | $had_error++, print "not " if !$_[0]; |
50 | print "ok"; |
51 | print " - $_[1]" if defined $_[1]; |
52 | print "\n"; |
a91e8a78 |
53 | } |
54 | |
55 | ok( eval "use Devel::GlobalDestruction; 1", "use Devel::GlobalDestruction" ); |
56 | |
57 | ok( defined &in_global_destruction, "exported" ); |
58 | |
41ec1eaf |
59 | ok( defined prototype \&in_global_destruction, "defined prototype" ); |
60 | |
61 | ok( prototype \&in_global_destruction eq "", "empty prototype" ); |
62 | |
a91e8a78 |
63 | ok( !in_global_destruction(), "not in GD" ); |
64 | |
38d57e49 |
65 | our $sg = Test::Scope::Guard->new(sub { ok( in_global_destruction(), "in GD" ) }); |