X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest%2FBaseSchema.pm;h=92234dc3ecd459beab720f3b4431a4f37ea021f4;hb=d931aae121a543895df014a8416f5b1f698c00f8;hp=82e4dd97bb0101d4c5026714c0643f0c1c2ad8c2;hpb=62cf2c2af2e4d6825fd719e05ba7ba44dc91401b;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/lib/DBICTest/BaseSchema.pm b/t/lib/DBICTest/BaseSchema.pm
index 82e4dd9..92234dc 100644
--- a/t/lib/DBICTest/BaseSchema.pm
+++ b/t/lib/DBICTest/BaseSchema.pm
@@ -8,7 +8,7 @@ use base qw(DBICTest::Base DBIx::Class::Schema);
 use Fcntl qw(:DEFAULT :seek :flock);
 use Time::HiRes 'sleep';
 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 {
@@ -108,7 +108,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}";
   }
 }
 
@@ -186,18 +187,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
@@ -208,12 +218,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 $!";