X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest%2FBaseSchema.pm;fp=t%2Flib%2FDBICTest%2FBaseSchema.pm;h=80d3fb12cba758a883c19609b536c7504f63f239;hb=69016f65df5f30e446734b8cc94c216915c9105b;hp=1c42201f4775d932d6714a3f8a17060b44e7f6a8;hpb=3c26d329524f0321209e7b6736357cc041772367;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/lib/DBICTest/BaseSchema.pm b/t/lib/DBICTest/BaseSchema.pm
index 1c42201..80d3fb1 100644
--- a/t/lib/DBICTest/BaseSchema.pm
+++ b/t/lib/DBICTest/BaseSchema.pm
@@ -9,7 +9,7 @@ use Fcntl qw(:DEFAULT :seek :flock);
 use Time::HiRes 'sleep';
 use Scope::Guard ();
 use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry);
-use DBICTest::Util 'local_umask';
+use DBICTest::Util qw( local_umask dbg DEBUG_TEST_CONCURRENCY_LOCKS );
 use namespace::clean;
 
 sub capture_executed_sql_bind {
@@ -119,7 +119,8 @@ our $locker;
 END {
   # we need the $locker to be referenced here for delayed destruction
   if ($locker->{lock_name} and ($ENV{DBICTEST_LOCK_HOLDER}||0) == $$) {
-    #warn "$$ $0 $locker->{type} LOCK RELEASED";
+    DEBUG_TEST_CONCURRENCY_LOCKS
+      and dbg "$locker->{type} LOCK RELEASED (END): $locker->{lock_name}";
   }
 }
 
@@ -197,18 +198,27 @@ sub connection {
 
       # this will release whatever lock we may currently be holding
       # which is fine since the type does not match as checked above
+      DEBUG_TEST_CONCURRENCY_LOCKS
+        and $locker
+        and dbg "$locker->{type} LOCK RELEASED (UNDEF): $locker->{lock_name}";
+
       undef $locker;
 
       my $lockpath = DBICTest::RunMode->tmpdir->file("_dbictest_$locktype.lock");
 
-      #warn "$$ $0 $locktype GRABBING LOCK";
+      DEBUG_TEST_CONCURRENCY_LOCKS
+        and dbg "Waiting for $locktype LOCK: $lockpath...";
+
       my $lock_fh;
       {
         my $u = local_umask(0); # so that the file opens as 666, and any user can lock
         sysopen ($lock_fh, $lockpath, O_RDWR|O_CREAT) or die "Unable to open $lockpath: $!";
       }
+
       flock ($lock_fh, LOCK_EX) or die "Unable to lock $lockpath: $!";
-      #warn "$$ $0 $locktype LOCK GRABBED";
+
+      DEBUG_TEST_CONCURRENCY_LOCKS
+        and dbg "Got $locktype LOCK: $lockpath";
 
       # see if anyone was holding a lock before us, and wait up to 5 seconds for them to terminate
       # if we do not do this we may end up trampling over some long-running END or somesuch
@@ -219,12 +229,17 @@ sub connection {
           and
         ($old_pid) = $old_pid =~ /^(\d+)$/
       ) {
+        DEBUG_TEST_CONCURRENCY_LOCKS
+          and dbg "Post-grab WAIT for $old_pid START: $lockpath";
+
         for (1..50) {
           kill (0, $old_pid) or last;
           sleep 0.1;
         }
+
+        DEBUG_TEST_CONCURRENCY_LOCKS
+          and dbg "Post-grab WAIT for $old_pid FINISHED: $lockpath";
       }
-      #warn "$$ $0 $locktype POST GRAB WAIT";
 
       truncate $lock_fh, 0;
       seek ($lock_fh, 0, SEEK_SET) or die "seek failed $!";