X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest%2FSchema.pm;h=61a43863f66849c6bd437cf9b263d6736d9c93b0;hb=6642a36f35c3292da6aa651370e7e4d8e75a1c4a;hp=be36371673c1dca2bfe53567159b609922e72603;hpb=8d6b1478d8fa6f7c76e313ee72a72d5eb4c24d03;p=dbsrgits%2FDBIx-Class-Historic.git

diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm
index be36371..61a4386 100644
--- a/t/lib/DBICTest/Schema.pm
+++ b/t/lib/DBICTest/Schema.pm
@@ -5,13 +5,13 @@ use strict;
 use warnings;
 no warnings 'qw';
 
-use base 'DBIx::Class::Schema';
+use base 'DBICTest::BaseSchema';
 
 use Fcntl qw/:DEFAULT :seek :flock/;
 use Time::HiRes 'sleep';
-use Path::Class::File;
-use File::Spec;
-use DBICTest::Util qw/populate_weakregistry assert_empty_weakregistry local_umask/;
+use DBICTest::RunMode;
+use DBICTest::Util::LeakTracer qw/populate_weakregistry assert_empty_weakregistry/;
+use DBICTest::Util 'local_umask';
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors(simple => 'custom_attr');
@@ -74,7 +74,7 @@ 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 $locktype LOCK RELEASED";
+    #warn "$$ $0 $locker->{type} LOCK RELEASED";
   }
 }
 
@@ -144,16 +144,30 @@ sub connection {
       ;
     };
 
+    # DBD::Firebird and DBD::InterBase could very well talk to the same RDBMS
+    # make an educated guesstimate based on the DSN
+    # (worst case scenario we are wrong and the scripts have to wait on each
+    # other even without actually being able to interfere among themselves)
+    if (
+      ($locktype||'') eq 'InterBase'
+        and
+      $_[0] =~ /firebird/i
+    ) {
+      $locktype = 'Firebird';
+    }
 
     # Never hold more than one lock. This solves the "lock in order" issues
     # unrelated tests may have
     # Also if there is no connection - there is no lock to be had
     if ($locktype and (!$locker or $locker->{type} ne $locktype)) {
 
-      warn "$$ $0 $locktype" if $locktype eq 'generic' or $locktype eq 'SQLite';
+      # this will release whatever lock we may currently be holding
+      # which is fine since the type does not match as checked above
+      undef $locker;
 
-      my $lockpath = File::Spec->tmpdir . "/.dbictest_$locktype.lock";
+      my $lockpath = DBICTest::RunMode->tmpdir->file(".dbictest_$locktype.lock");
 
+      #warn "$$ $0 $locktype GRABBING LOCK";
       my $lock_fh;
       {
         my $u = local_umask(0); # so that the file opens as 666, and any user can lock
@@ -165,7 +179,12 @@ sub connection {
       # 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
       seek ($lock_fh, 0, SEEK_SET) or die "seek failed $!";
-      if (read ($lock_fh, my $old_pid, 100) ) {
+      my $old_pid;
+      if (
+        read ($lock_fh, $old_pid, 100)
+          and
+        ($old_pid) = $old_pid =~ /^(\d+)$/
+      ) {
         for (1..50) {
           kill (0, $old_pid) or last;
           sleep 0.1;