From: Vincent Pit <vince@profvince.com>
Date: Sun, 24 Jun 2012 21:45:52 +0000 (+0200)
Subject: Move the global destruction logic of t/15-self.t out in an helper module
X-Git-Tag: rt77991~4
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=4e0c022bbcc3cdb56a07f5a4a305808585087d8d;p=perl%2Fmodules%2FVariable-Magic.git

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

diff --git a/MANIFEST b/MANIFEST
index d984750..8d8762f 100644
--- 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 bf6aa35..1491dfe 100644
--- 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
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;