Restructure thread/fork tests to run with maximum concurrency

[dbsrgits/DBIx-Class.git] / t / 51threadnodb.t

diff --git a/t/51threadnodb.t b/t/51threadnodb.t
index 30e8aec..ab3683c 100644 (file)
--- 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;