t/01_basic.t

   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 BEGIN {
  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 print "1..9\n";
  29
  30 our $had_error;
  31
  32 # try to ensure this is the last-most END so we capture future tests
  33 # running in other ENDs
  34 require B;
  35 my $reinject_retries = my $max_retry = 5;
  36 my $end_worker;
  37 $end_worker = sub {
  38   my $tail = (B::end_av()->ARRAY)[-1];
  39   if (!defined $tail or $tail == $end_worker) {
  40     $? = $had_error || 0;
  41     $reinject_retries = 0;
  42   }
  43   elsif ($reinject_retries--) {
  44     push @{B::end_av()->object_2svref}, $end_worker;
  45   }
  46   else {
  47     print STDERR "\n\nSomething is racing with @{[__FILE__]} for final END block definition - can't win after $max_retry iterations :(\n\n";
  48     require POSIX;
  49     POSIX::_exit( 255 );
  50   }
  51 };
  52 END { push @{B::end_av()->object_2svref}, $end_worker }
  53
  54 sub ok ($$) {
  55   $had_error++, print "not " if !$_[0];
  56   print "ok";
  57   print " - $_[1]" if defined $_[1];
  58   print "\n";
  59 }
  60
  61 END {
  62   ok( ! in_global_destruction(), 'Not yet in GD while in END block 2' )
  63 }
  64
  65 ok( eval "use Devel::GlobalDestruction; 1", "use Devel::GlobalDestruction" );
  66
  67 ok( defined &in_global_destruction, "exported" );
  68
  69 ok( defined prototype \&in_global_destruction, "defined prototype" );
  70
  71 ok( prototype \&in_global_destruction eq "", "empty prototype" );
  72
  73 ok( ! in_global_destruction(), "Runtime is not GD" );
  74
  75 our $sg1 = Test::Scope::Guard->new(sub { ok( in_global_destruction(), "Final cleanup object destruction properly in GD" ) });
  76
  77 END {
  78   ok( ! in_global_destruction(), 'Not yet in GD while in END block 1' )
  79 }
  80
  81 our $sg2 = Test::Scope::Guard->new(sub { ok( ! in_global_destruction(), "Object destruction in END not considered GD" ) });
  82 END { undef $sg2 }