t/01_basic.t

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