t/lib/Variable/Magic/TestGlobalDestruction.pm

   1 package Variable::Magic::TestGlobalDestruction;
   2
   3 use strict;
   4 use warnings;
   5
   6 # Silence possible 'used only once' warnings from Test::Builder
   7 our $TODO;
   8 local $TODO;
   9
  10 sub _diag {
  11  require Test::More;
  12  Test::More::diag(@_);
  13 }
  14
  15 sub import {
  16  shift;
  17  my %args  = @_;
  18  my $level = $args{level} || 1;
  19
  20  my $env_level = int($ENV{PERL_DESTRUCT_LEVEL} || 0);
  21  if ($env_level >= $level) {
  22   my $is_debugging = do {
  23    local $@;
  24    eval {
  25     require Config;
  26     grep /-DDEBUGGING\b/, @Config::Config{qw<ccflags cppflags optimize>};
  27    }
  28   };
  29   require Test::More;
  30   if ($is_debugging) {
  31    _diag("Global destruction level $env_level set by PERL_DESTRUCT_LEVEL (debugging perl)");
  32    return;
  33   } else {
  34    _diag("PERL_DESTRUCT_LEVEL is set to $env_level, but this perl doesn't seem to have debugging enabled");
  35   }
  36  }
  37
  38  my $has_perl_destruct_level = do {
  39   local $@;
  40   eval {
  41    require Perl::Destruct::Level;
  42    Perl::Destruct::Level->import(level => $level);
  43    1;
  44   }
  45  };
  46  if ($has_perl_destruct_level) {
  47   _diag("Global destruction level $level set by Perl::Destruct::Level");
  48   return;
  49  }
  50 }
  51
  52 1;