t/01_basic.t

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