X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest.pm;h=d09a9dc3264cbea08db86f2ae28a29e050a25098;hb=e43288721573f6b73a16e1340d8a533e04642d6f;hp=91a0c792915f99918f3546d546fd1c5b856e9c0d;hpb=439a7283a981f27a56e745d99e456fc50a5a018f;p=dbsrgits%2FDBIx-Class.git diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm index 91a0c79..d09a9dc 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,12 +26,14 @@ BEGIN { } -use DBICTest::Util qw( local_umask tmpdir await_flock dbg DEBUG_TEST_CONCURRENCY_LOCKS ); -use DBICTest::Schema; +use DBICTest::Util qw( + local_umask slurp_bytes 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 (); use Fcntl qw/:DEFAULT :flock/; use Config; @@ -148,36 +151,21 @@ sub import { } END { - # referencing here delays destruction even more - if ($global_lock_fh) { - DEBUG_TEST_CONCURRENCY_LOCKS > 1 - and dbg "Release @{[ $global_exclusive_lock ? 'EXCLUSIVE' : 'SHARED' ]} global lock (END)"; - 1; - } -} - -{ - my $dir = Path::Class::File->new(__FILE__)->dir->parent->subdir('var'); - $dir->mkpath unless -d "$dir"; - $dir = "$dir"; + # referencing here delays destruction even more + if ($global_lock_fh) { + DEBUG_TEST_CONCURRENCY_LOCKS > 1 + and dbg "Release @{[ $global_exclusive_lock ? 'EXCLUSIVE' : 'SHARED' ]} global lock (END)"; + 1; + } - sub _sqlite_dbfilename { - my $holder = $ENV{DBICTEST_LOCK_HOLDER} || $$; - $holder = $$ if $holder == -1; + _cleanup_dbfile(); +} - # useful for missing cleanup debugging - #if ( $holder == $$) { - # my $x = $0; - # $x =~ s/\//#/g; - # $holder .= "-$x"; - #} +sub _sqlite_dbfilename { + my $holder = $ENV{DBICTEST_LOCK_HOLDER} || $$; + $holder = $$ if $holder == -1; - return "$dir/DBIxClass-$holder.db"; - } - - END { - _cleanup_dbfile(); - } + return "t/var/DBIxClass-$holder.db"; } $SIG{INT} = sub { _cleanup_dbfile(); exit 1 }; @@ -276,7 +264,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 ); @@ -435,9 +423,7 @@ sub deploy_schema { if ($ENV{"DBICTEST_SQLT_DEPLOY"}) { $schema->deploy($args); } else { - my $filename = Path::Class::File->new(__FILE__)->dir - ->file('sqlite.sql')->stringify; - my $sql = do { local (@ARGV, $/) = $filename ; <> }; + my $sql = slurp_bytes( 't/lib/sqlite.sql' ); for my $chunk ( split (/;\s*\n+/, $sql) ) { if ( $chunk =~ / ^ (?! --\s* ) \S /xm ) { # there is some real sql in the chunk - a non-space at the start of the string which is not a comment $schema->storage->dbh_do(sub { $_[1]->do($chunk) }) or print "Error on SQL: $chunk\n";