Commit | Line | Data |
09b12813 |
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 | |
28 | sub ok ($$) { |
29 | print "not " if !$_[0]; |
30 | print "ok"; |
31 | print " - $_[1]" if defined $_[1]; |
32 | print "\n"; |
33 | !!$_[0] |
34 | } |
35 | |
36 | BEGIN { |
37 | require B; |
38 | B::minus_c(); |
39 | |
5629eb97 |
40 | print "1..3\n"; |
09b12813 |
41 | ok( $^C, "Test properly running under minus-c" ); |
42 | } |
43 | |
44 | use Devel::GlobalDestruction; |
45 | |
5629eb97 |
46 | BEGIN { |
47 | ok !in_global_destruction(), "BEGIN is not GD with -c"; |
48 | } |
49 | |
09b12813 |
50 | our $foo; |
51 | BEGIN { |
52 | $foo = Test::Scope::Guard->new( sub { |
53 | ok( in_global_destruction(), "Final cleanup object destruction properly in GD" ) or do { |
54 | require POSIX; |
55 | POSIX::_exit(1); |
56 | }; |
57 | }); |
58 | } |