t/01_basic.t

   1 use strict;
   2 use warnings;
   3 no warnings 'once';
   4
   5 BEGIN {
   6   package Test::Scope::Guard;
   7   sub new { my ($class, $code) = @_; bless [$code], $class; }
   8   sub DESTROY { my $self = shift; $self->[0]->() }
   9 }
  10
  11 print "1..8\n";
  12
  13 our $had_error;
  14
  15 sub ok ($$) {
  16   $had_error++, print "not " if !$_[0];
  17   print "ok";
  18   print " - $_[1]" if defined $_[1];
  19   print "\n";
  20 }
  21
  22 END {
  23   ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), 'Not yet in GD while in END block 2' )
  24 }
  25
  26 ok( eval "use Devel::GlobalDestruction::XS; 1", "use Devel::GlobalDestruction::XS" );
  27
  28 ok( defined prototype \&Devel::GlobalDestruction::XS::in_global_destruction, "defined prototype" );
  29
  30 ok( prototype \&Devel::GlobalDestruction::XS::in_global_destruction eq "", "empty prototype" );
  31
  32 ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), "Runtime is not GD" );
  33
  34 our $sg1 = Test::Scope::Guard->new(sub { ok( Devel::GlobalDestruction::XS::in_global_destruction(), "Final cleanup object destruction properly in GD" ) });
  35
  36 END {
  37   ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), 'Not yet in GD while in END block 1' )
  38 }
  39
  40 our $sg2 = Test::Scope::Guard->new(sub { ok( ! Devel::GlobalDestruction::XS::in_global_destruction(), "Object destruction in END not considered GD" ) });
  41 END { undef $sg2 }