Move the global destruction logic of t/15-self.t out in an helper module

diff --git a/MANIFEST b/MANIFEST
index d984750422c45381c6530aef0fc62b19ec36112c..8d8762f2a3330dde41a27f3ca0ad96a7c7eaa10c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -44,6 +44,7 @@ t/92-pod-coverage.t
 t/95-portability-files.t
 t/99-kwalitee.t
 t/lib/Variable/Magic/TestDestroyRequired.pm
+t/lib/Variable/Magic/TestGlobalDestruction.pm
 t/lib/Variable/Magic/TestScopeEnd.pm
 t/lib/Variable/Magic/TestThreads.pm
 t/lib/Variable/Magic/TestValue.pm

diff --git a/t/15-self.t b/t/15-self.t
index bf6aa350f5cdc6ac3ad1cffc11449b9bebb5167d..1491dfe372b294a9f72457e3e173c7f12f858fbe 100644 (file)
--- a/t/15-self.t
+++ b/t/15-self.t
@@ -7,6 +7,9 @@ use Test::More tests => 17;
 
 use Variable::Magic qw<wizard cast dispell getdata>;
 
+use lib 't/lib';
+use Variable::Magic::TestGlobalDestruction;
+
 my $c = 0;
 
 {
@@ -54,8 +57,3 @@ eval q[
  BEGIN { require Variable::Magic::TestDestroyRequired; }
 ];
 is $@, '', 'wizard destruction at the end of BEGIN-time require doesn\'t panic';
-
-if ((defined $ENV{PERL_DESTRUCT_LEVEL} and $ENV{PERL_DESTRUCT_LEVEL} >= 3)
-    or eval "use Perl::Destruct::Level level => 3; 1") {
- diag 'Test global destruction';
-}

diff --git a/t/lib/Variable/Magic/TestGlobalDestruction.pm b/t/lib/Variable/Magic/TestGlobalDestruction.pm
new file mode 100644 (file)
index 0000000..7a4721a
--- /dev/null
+++ b/t/lib/Variable/Magic/TestGlobalDestruction.pm
@@ -0,0 +1,52 @@
+package Variable::Magic::TestGlobalDestruction;
+
+use strict;
+use warnings;
+
+# Silence possible 'used only once' warnings from Test::Builder
+our $TODO;
+local $TODO;
+
+sub _diag {
+ require Test::More;
+ Test::More::diag(@_);
+}
+
+sub import {
+ shift;
+ my %args  = @_;
+ my $level = $args{level} || 1;
+
+ my $env_level = int($ENV{PERL_DESTRUCT_LEVEL} || 0);
+ if ($env_level >= $level) {
+  my $is_debugging = do {
+   local $@;
+   eval {
+    require Config;
+    grep /-DDEBUGGING\b/, @Config::Config{qw<ccflags cppflags optimize>};
+   }
+  };
+  require Test::More;
+  if ($is_debugging) {
+   _diag("Global destruction level $env_level set by PERL_DESTRUCT_LEVEL (debugging perl)");
+   return;
+  } else {
+   _diag("PERL_DESTRUCT_LEVEL is set to $env_level, but this perl doesn't seem to have debugging enabled");
+  }
+ }
+
+ my $has_perl_destruct_level = do {
+  local $@;
+  eval {
+   require Perl::Destruct::Level;
+   Perl::Destruct::Level->import(level => $level);
+   1;
+  }
+ };
+ if ($has_perl_destruct_level) {
+  _diag("Global destruction level $level set by Perl::Destruct::Level");
+  return;
+ }
+}
+
+1;