X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F51threadnodb.t;h=ab3683c8379a360a22d803a87c13da8ac58e70bb;hb=10dd5c05fee5be6ff4d72e41ab0d7b51809fdb5a;hp=30e8aec6506f416e521a90044b38f41bbf53850f;hpb=bd52af73fba43175e16439d2a241dbf9d468cd5f;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/51threadnodb.t b/t/51threadnodb.t
index 30e8aec..ab3683c 100644
--- a/t/51threadnodb.t
+++ b/t/51threadnodb.t
@@ -19,6 +19,7 @@ use warnings;
 use Test::More;
 use Errno ();
 use DBIx::Class::_Util 'sigwarn_silencer';
+use Time::HiRes qw(time sleep);
 
 use DBICTest;
 
@@ -28,16 +29,20 @@ plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
 plan skip_all => 'Potential problems on Win32 Perl < 5.14 and Variable::Magic - investigation pending'
   if $^O eq 'MSWin32' && "$]" < 5.014 && DBICTest::RunMode->is_plain;
 
-# README: If you set the env var to a number greater than 10,
+# README: If you set the env var to a number greater than 5,
 #   we will use that many children
 my $num_children = $ENV{DBICTEST_THREAD_STRESS} || 1;
-if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
-   $num_children = 10;
+if($num_children !~ /^[0-9]+$/ || $num_children < 5) {
+   $num_children = 5;
 }
 
 my $schema = DBICTest->init_schema(no_deploy => 1);
 isa_ok ($schema, 'DBICTest::Schema');
 
+# sleep until this spot so everything starts simultaneously
+# add "until turn of second" for prettier display
+my $t = int( time() ) + 4;
+
 my @threads;
 SKIP: {
 
@@ -45,12 +50,17 @@ SKIP: {
 
   for (1.. $num_children) {
     push @threads, threads->create(sub {
+      my $tid = threads->tid;
+
+      sleep ($t - time);
+      note ("Thread $tid starting work at " . time() );
+
       my $rsrc = $schema->source('Artist');
       undef $schema;
       isa_ok ($rsrc->schema, 'DBICTest::Schema');
       my $s2 = $rsrc->schema->clone;
 
-      sleep 1;  # without this many tasty crashes
+      sleep (0.2); # without this many tasty crashes even on latest perls
     }) || do {
       skip "EAGAIN encountered, your system is likely bogged down: skipping rest of test", 1
         if $! == Errno::EAGAIN();
@@ -65,4 +75,9 @@ ok(1, "past spawning");
 $_->join for @threads;
 ok(1, "past joining");
 
+# Too many threading bugs on exit, none of which have anything to do with
+# the actual stuff we test
+$ENV{DBICTEST_DIRTY_EXIT} = 1
+  if "$]"< 5.012;
+
 done_testing;