t/03_minusc.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 {
  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 sub ok ($$) {
  29   print "not " if !$_[0];
  30   print "ok";
  31   print " - $_[1]" if defined $_[1];
  32   print "\n";
  33   !!$_[0]
  34 }
  35
  36 BEGIN {
  37   require B;
  38   B::minus_c();
  39
  40   print "1..3\n";
  41   ok( $^C, "Test properly running under minus-c" );
  42 }
  43
  44 use Devel::GlobalDestruction;
  45
  46 BEGIN {
  47     ok !in_global_destruction(), "BEGIN is not GD with -c";
  48 }
  49
  50 our $foo;
  51 BEGIN {
  52   $foo = Test::Scope::Guard->new( sub {
  53     ok( in_global_destruction(), "Final cleanup object destruction properly in GD" ) or do {
  54       require POSIX;
  55       POSIX::_exit(1);
  56     };
  57   });
  58 }