t/01_basic.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5   if ($ENV{DEVEL_GLOBALDESTRUCTION_PP_TEST}) {
   6     require DynaLoader;
   7     no warnings 'redefine';
   8     my $orig = \&DynaLoader::bootstrap;
   9     *DynaLoader::bootstrap = sub {
  10       die 'no XS' if $_[0] eq 'Devel::GlobalDestruction';
  11       goto $orig;
  12     };
  13   }
  14 }
  15
  16 BEGIN {
  17   package Test::Scope::Guard;
  18   sub new { my ($class, $code) = @_; bless [$code], $class; }
  19   sub DESTROY { my $self = shift; $self->[0]->() }
  20 }
  21
  22 print "1..6\n";
  23
  24 our $had_error;
  25
  26 # try to ensure this is the last-most END so we capture future tests
  27 # running in other ENDs
  28 require B;
  29 my $reinject_retries = my $max_retry = 5;
  30 my $end_worker;
  31 $end_worker = sub {
  32   my $tail = (B::end_av()->ARRAY)[-1];
  33   if (!defined $tail or $tail == $end_worker) {
  34     $? = $had_error || 0;
  35     $reinject_retries = 0;
  36   }
  37   elsif ($reinject_retries--) {
  38     push @{B::end_av()->object_2svref}, $end_worker;
  39   }
  40   else {
  41     print STDERR "\n\nSomething is racing with @{[__FILE__]} for final END block definition - can't win after $max_retry iterations :(\n\n";
  42     require POSIX;
  43     POSIX::_exit( 255 );
  44   }
  45 };
  46 END { push @{B::end_av()->object_2svref}, $end_worker }
  47
  48 sub ok ($$) {
  49   $had_error++, print "not " if !$_[0];
  50   print "ok";
  51   print " - $_[1]" if defined $_[1];
  52   print "\n";
  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(), "not in GD" );
  64
  65 our $sg = Test::Scope::Guard->new(sub { ok( in_global_destruction(), "in GD" ) });