From: Vincent Pit 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; +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}; + } + }; + 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;