X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest.pm;h=6da2f7e5c9d63346d17540dd63f1a09e7e3455a5;hb=69016f65;hp=229859dd70005220c1bddad5fb83533278da3529;hpb=3c26d329524f0321209e7b6736357cc041772367;p=dbsrgits%2FDBIx-Class.git diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm index 229859d..6da2f7e 100644 --- a/t/lib/DBICTest.pm +++ b/t/lib/DBICTest.pm @@ -4,7 +4,7 @@ package # hide from PAUSE use strict; use warnings; -use DBICTest::Util 'local_umask'; +use DBICTest::Util qw( local_umask dbg DEBUG_TEST_CONCURRENCY_LOCKS ); use DBICTest::Schema; use DBICTest::Util::LeakTracer qw/populate_weakregistry assert_empty_weakregistry/; use DBIx::Class::_Util 'detected_reinvoked_destructor'; @@ -91,7 +91,14 @@ sub import { for my $exp (@_) { if ($exp eq ':GlobalLock') { + DEBUG_TEST_CONCURRENCY_LOCKS > 1 + and dbg "Waiting for EXCLUSIVE global lock..."; + flock ($global_lock_fh, LOCK_EX) or die "Unable to lock $lockpath: $!"; + + DEBUG_TEST_CONCURRENCY_LOCKS > 1 + and dbg "Got EXCLUSIVE global lock"; + $global_exclusive_lock = 1; } elsif ($exp eq ':DiffSQL') { @@ -108,13 +115,22 @@ sub import { } unless ($global_exclusive_lock) { + DEBUG_TEST_CONCURRENCY_LOCKS > 1 + and dbg "Waiting for SHARED global lock..."; + flock ($global_lock_fh, LOCK_SH) or die "Unable to lock $lockpath: $!"; + + DEBUG_TEST_CONCURRENCY_LOCKS > 1 + and dbg "Got SHARED global lock"; } } END { + # referencing here delays destruction even more if ($global_lock_fh) { - # delay destruction even more + DEBUG_TEST_CONCURRENCY_LOCKS > 1 + and dbg "Release @{[ $global_exclusive_lock ? 'EXCLUSIVE' : 'SHARED' ]} global lock (END)"; + 1; } }