1 package Variable::Magic::TestGlobalDestruction;
6 # Silence possible 'used only once' warnings from Test::Builder
17 sub is_debugging_perl {
18 return $is_debugging if defined $is_debugging;
22 my $has_config_perl_v = do {
24 eval { require Config::Perl::V; 1 };
27 if ($has_config_perl_v) {
30 eval { Config::Perl::V::myconfig()->{build}{options}{DEBUGGING} };
33 if (defined $is_debugging) {
34 $source = "Config::Perl::V version $Config::Perl::V::VERSION";
38 unless (defined $is_debugging) {
43 my @fields = qw<ccflags cppflags optimize>;
45 for my $field (@fields) {
46 my $content = $Config::Config{$field};
48 while ($content =~ /(-DD?EBUGGING((?:=\S*)?))/g) {
50 if ($extra ne '=none') {
52 $source = "\$Config{$field} =~ /$1/";
58 my $maybe_is = $is_debugging ? "is" : "is NOT";
59 _diag("According to $source, this $maybe_is a debugging perl");
68 my $level = $args{level};
69 $level = 1 unless defined $level;
71 if ("$]" < 5.013_004 and not $ENV{PERL_FORCE_TEST_THREADS}) {
72 _diag("perl 5.13.4 required to safely test global destruction");
76 my $env_level = $ENV{PERL_DESTRUCT_LEVEL};
77 if (defined $env_level) {
78 no warnings 'numeric';
79 $env_level = int $env_level;
82 my $is_debugging = is_debugging_perl();
84 if (defined $env_level) {
85 _diag("Global destruction level $env_level set by PERL_DESTRUCT_LEVEL (environment)");
86 return ($env_level >= $level) ? 1 : 0;
88 $ENV{PERL_DESTRUCT_LEVEL} = $level;
89 _diag("Global destruction level $level set by PERL_DESTRUCT_LEVEL (forced)");
92 } elsif (defined $env_level) {
93 _diag("PERL_DESTRUCT_LEVEL is set to $env_level, but this perl doesn't seem to have debugging enabled, ignoring");
96 my $has_perl_destruct_level = do {
99 require Perl::Destruct::Level;
100 Perl::Destruct::Level->import(level => $level);
105 if ($has_perl_destruct_level) {
106 _diag("Global destruction level $level set by Perl::Destruct::Level");
110 _diag("Not testing global destruction");