t/04_phases.t

   1 use strict;
   2 use warnings;
   3
   4 {
   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 my $had_error = 0;
  11 END { $? = $had_error }
  12 sub ok ($$) {
  13   $had_error++, print "not " if !$_[0];
  14   print "ok";
  15   print " - $_[1]" if defined $_[1];
  16   print "\n";
  17   !!$_[0]
  18 }
  19
  20 use Devel::GlobalDestruction::XS;
  21
  22 sub check_not_global {
  23   my $phase = shift;
  24   ok !Devel::GlobalDestruction::XS::in_global_destruction(), "$phase is not GD";
  25   Test::Scope::Guard->new( sub {
  26     ok( !Devel::GlobalDestruction::XS::in_global_destruction(), "DESTROY in $phase still not GD" );
  27   });
  28 }
  29
  30 BEGIN {
  31   print "1..10\n";
  32 }
  33
  34 BEGIN { check_not_global('BEGIN') }
  35
  36 BEGIN {
  37   if (eval 'UNITCHECK {}; 1') {
  38     eval q[ UNITCHECK { check_not_global('UNITCHECK') }; 1 ]
  39       or die $@;
  40   }
  41   else {
  42     print "ok # UNITCHECK not supported in perl < 5.10\n" x 2;
  43   }
  44 }
  45
  46 CHECK { check_not_global('CHECK') }
  47 sub CLONE { check_not_global('CLONE') };
  48 INIT { check_not_global('INIT') }
  49 END { check_not_global('END') }