X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F01_basic.t;h=c8d847f052ceaaad4be01fbe02dc97461ad6f685;hb=754056f2221e2d174895f3dc6967f6da695333a5;hp=b1565067abb22956209671326aa47f82897900b9;hpb=53daa8381ac1962b80e5becbffc1d1a2017c9df5;p=p5sagit%2FDevel-GlobalDestruction.git diff --git a/t/01_basic.t b/t/01_basic.t index b156506..c8d847f 100644 --- a/t/01_basic.t +++ b/t/01_basic.t @@ -3,12 +3,8 @@ use warnings; BEGIN { if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) { - require DynaLoader; - no warnings 'redefine'; - my $orig = \&DynaLoader::bootstrap; - *DynaLoader::bootstrap = sub { - die 'no XS' if $_[0] eq 'Devel::GlobalDestruction'; - goto $orig; + unshift @INC, sub { + die 'no XS' if $_[1] eq 'Devel/GlobalDestruction/XS.pm'; }; } } @@ -19,10 +15,38 @@ BEGIN { sub DESTROY { my $self = shift; $self->[0]->() } } -print "1..6\n"; +print "1..9\n"; + +our $had_error; + +# try to ensure this is the last-most END so we capture future tests +# running in other ENDs +if ($] >= 5.008) { + require B; + my $reinject_retries = my $max_retry = 5; + my $end_worker; + $end_worker = sub { + my $tail = (B::end_av()->ARRAY)[-1]; + if (!defined $tail or $tail == $end_worker) { + $? = $had_error || 0; + $reinject_retries = 0; + } + elsif ($reinject_retries--) { + push @{B::end_av()->object_2svref}, $end_worker; + } + else { + print STDERR "\n\nSomething is racing with @{[__FILE__]} for final END block definition - can't win after $max_retry iterations :(\n\n"; + require POSIX; + POSIX::_exit( 255 ); + } + }; + eval 'END { push @{B::end_av()->object_2svref}, $end_worker }'; +} +# B::end_av isn't available on 5.6, so just use a basic end block +else { + eval 'END { $? = $had_error || 0 }'; +} -my $had_error = 0; -END { $? = $had_error }; sub ok ($$) { $had_error++, print "not " if !$_[0]; print "ok"; @@ -30,6 +54,10 @@ sub ok ($$) { print "\n"; } +END { + ok( ! in_global_destruction(), 'Not yet in GD while in END block 2' ) +} + ok( eval "use Devel::GlobalDestruction; 1", "use Devel::GlobalDestruction" ); ok( defined &in_global_destruction, "exported" ); @@ -38,6 +66,14 @@ ok( defined prototype \&in_global_destruction, "defined prototype" ); ok( prototype \&in_global_destruction eq "", "empty prototype" ); -ok( !in_global_destruction(), "not in GD" ); +ok( ! in_global_destruction(), "Runtime is not GD" ); + +our $sg1; +$sg1 = Test::Scope::Guard->new(sub { ok( in_global_destruction(), "Final cleanup object destruction properly in GD" ) }); + +END { + ok( ! in_global_destruction(), 'Not yet in GD while in END block 1' ) +} -our $sg = Test::Scope::Guard->new(sub { ok( in_global_destruction(), "in GD" ) }); +our $sg2 = Test::Scope::Guard->new(sub { ok( ! in_global_destruction(), "Object destruction in END not considered GD" ) }); +END { undef $sg2 }