From: Peter Rabbitson Date: Sun, 14 Feb 2016 10:39:14 +0000 (+0100) Subject: Untangle strictly-DBICTest constant from the main constant set X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=08a8d8f1b8a69ea29bcceb9f399214943a34905c;p=dbsrgits%2FDBIx-Class-Historic.git Untangle strictly-DBICTest constant from the main constant set Not sure what I was thinking when I wrote this --- diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index 7d61118..73998d2 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -376,7 +376,8 @@ my $method_dispatch = { )], }; -if (DBIx::Class::_ENV_::DBICTEST) { +# this only happens during DBIC-internal testing +if ( $INC{"t/lib/ANFANG.pm"} ) { my $seen; for my $type (keys %$method_dispatch) { diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index b5991fb..358a3aa 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -23,12 +23,6 @@ BEGIN { UNSTABLE_DOLLARAT => ( "$]" < 5.013002 ) ? 1 : 0, - DBICTEST => $INC{"DBICTest/Util.pm"} ? 1 : 0, - - # During 5.13 dev cycle HELEMs started to leak on copy - # add an escape for these perls ON SMOKERS - a user will still get death - PEEPEENESS => ( eval { DBICTest::RunMode->is_smoker } && ( "$]" >= 5.013005 and "$]" <= 5.013006) ), - ( map # # the "DBIC_" prefix below is crucial - this is what makes CI pick up diff --git a/t/52leaks.t b/t/52leaks.t index c7af701..cfeaadc 100644 --- a/t/52leaks.t +++ b/t/52leaks.t @@ -23,16 +23,16 @@ use strict; use warnings; use Test::More; +BEGIN { + require DBICTest::Util; + plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test" + if DBICTest::Util::PEEPEENESS(); +} use DBICTest::RunMode; use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs); use Scalar::Util qw(weaken blessed reftype); use DBIx::Class::_Util qw(hrefaddr sigwarn_silencer modver_gt_or_eq modver_gt_or_eq_and_lt); -BEGIN { - plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test" - if DBIx::Class::_ENV_::PEEPEENESS; -} - my $TB = Test::More->builder; if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) { diff --git a/t/71mysql.t b/t/71mysql.t index 9d2c5d0..4ea9aa2 100644 --- a/t/71mysql.t +++ b/t/71mysql.t @@ -12,7 +12,7 @@ use B::Deparse; use DBI::Const::GetInfoType; use Scalar::Util qw/weaken/; - +use DBICTest::Util 'PEEPEENESS'; use DBICTest; my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/}; @@ -411,7 +411,7 @@ ZEROINSEARCH: { { local $TODO = "Perl $] is known to leak like a sieve" - if DBIx::Class::_ENV_::PEEPEENESS; + if PEEPEENESS; ok (! defined $orig_dbh, 'Parent $dbh handle is gone'); } @@ -435,7 +435,7 @@ ZEROINSEARCH: { { local $TODO = "Perl $] is known to leak like a sieve" - if DBIx::Class::_ENV_::PEEPEENESS; + if PEEPEENESS; ok (! defined $orig_dbh, 'DBIC operation triggered reconnect - old $dbh is gone'); } diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm index 91a0c79..762abac 100644 --- a/t/lib/DBICTest.pm +++ b/t/lib/DBICTest.pm @@ -7,6 +7,7 @@ use ANFANG; use strict; use warnings; + # this noop trick initializes the STDOUT, so that the TAP::Harness # issued IO::Select->can_read calls (which are blocking wtf wtf wtf) # keep spinning and scheduling jobs @@ -25,9 +26,12 @@ BEGIN { } -use DBICTest::Util qw( local_umask tmpdir await_flock dbg DEBUG_TEST_CONCURRENCY_LOCKS ); -use DBICTest::Schema; +use DBICTest::Util qw( + local_umask tmpdir await_flock + dbg DEBUG_TEST_CONCURRENCY_LOCKS PEEPEENESS +); use DBICTest::Util::LeakTracer qw/populate_weakregistry assert_empty_weakregistry/; +use DBICTest::Schema; use DBIx::Class::_Util qw( detected_reinvoked_destructor scope_guard ); use Carp; use Path::Class::File (); @@ -276,7 +280,7 @@ sub __mk_disconnect_guard { return if ( # this perl leaks handles, delaying DESTROY, can't work right - DBIx::Class::_ENV_::PEEPEENESS + PEEPEENESS or ! -f $db_file ); diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm index c8893c8..5911f9a 100644 --- a/t/lib/DBICTest/Util.pm +++ b/t/lib/DBICTest/Util.pm @@ -5,11 +5,27 @@ use strict; use ANFANG; -use constant DEBUG_TEST_CONCURRENCY_LOCKS => - ( ($ENV{DBICTEST_DEBUG_CONCURRENCY_LOCKS}||'') =~ /^(\d+)$/ )[0] - || - 0 -; +use DBICTest::RunMode; + +use constant { + + DEBUG_TEST_CONCURRENCY_LOCKS => ( + ( ($ENV{DBICTEST_DEBUG_CONCURRENCY_LOCKS}||'') =~ /^(\d+)$/ )[0] + || + 0 + ), + + # During 5.13 dev cycle HELEMs started to leak on copy + # add an escape for these perls ON SMOKERS - a user/CI will still get death + # constname a homage to http://theoatmeal.com/comics/working_home + PEEPEENESS => ( + DBICTest::RunMode->is_smoker + and + ! DBICTest::RunMode->is_ci + and + ( "$]" >= 5.013005 and "$]" <= 5.013006) + ), +}; use Config; use Carp qw(cluck confess croak); @@ -21,7 +37,7 @@ use base 'Exporter'; our @EXPORT_OK = qw( dbg stacktrace local_umask tmpdir find_co_root - visit_namespaces + visit_namespaces PEEPEENESS check_customcond_args await_flock DEBUG_TEST_CONCURRENCY_LOCKS ); diff --git a/t/storage/error.t b/t/storage/error.t index 3cb7a28..e8996fa 100644 --- a/t/storage/error.t +++ b/t/storage/error.t @@ -7,7 +7,7 @@ use Test::More; use Test::Warn; use Test::Exception; - +use DBICTest::Util 'PEEPEENESS'; use DBICTest; for my $conn_args ( @@ -95,9 +95,8 @@ throws_ok ( # exception fallback: SKIP: { - if ( !!DBIx::Class::_ENV_::PEEPEENESS ) { - skip "Your perl version $] appears to leak like a sieve - skipping garbage collected \$schema test", 1; - } + skip "Your perl version $] appears to leak like a sieve - skipping garbage collected \$schema test", 1 + if PEEPEENESS; undef ($schema); throws_ok ( diff --git a/xt/extra/lean_startup.t b/xt/extra/lean_startup.t index af1f3e8..e699ee5 100644 --- a/xt/extra/lean_startup.t +++ b/xt/extra/lean_startup.t @@ -112,7 +112,6 @@ BEGIN { Sub::Defer Sub::Quote - File::Spec Scalar::Util List::Util Storable