X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F51threadnodb.t;h=3af78d57545ec4a772db1b295dacb03b3c9a329c;hb=63af9ced21d59d5d92099a9b8853c2eece90569a;hp=52cdcd8b52147fdce6ed9ede28b370fc8a03fd8c;hpb=2d12a809476ffe97dfa2b5e66d4ccdf13b24fc5e;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/51threadnodb.t b/t/51threadnodb.t
index 52cdcd8..3af78d5 100644
--- a/t/51threadnodb.t
+++ b/t/51threadnodb.t
@@ -4,19 +4,28 @@ BEGIN {
     print "1..0 # SKIP your perl does not support ithreads\n";
     exit 0;
   }
+
+  if ($INC{'Devel/Cover.pm'}) {
+    print "1..0 # SKIP Devel::Cover does not work with threads yet\n";
+    exit 0;
+  }
 }
 use threads;
 
 use strict;
 use warnings;
 use Test::More;
-
-plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
-  if $] < '5.008005';
+use DBIx::Class::_Util 'sigwarn_silencer';
 
 use lib qw(t/lib);
 use DBICTest;
 
+plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
+  if "$]" < 5.008005;
+
+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,
 #   we will use that many children
 my $num_children = $ENV{DBICTEST_THREAD_STRESS} || 1;
@@ -28,14 +37,27 @@ my $schema = DBICTest->init_schema(no_deploy => 1);
 isa_ok ($schema, 'DBICTest::Schema');
 
 my @threads;
-push @threads, threads->create(sub {
-  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
-}) for (1.. $num_children);
+SKIP: {
+
+  local $SIG{__WARN__} = sigwarn_silencer( qr/Thread creation failed/i );
+
+  for (1.. $num_children) {
+    push @threads, threads->create(sub {
+      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
+    }) || do {
+      skip "EAGAIN encountered, your system is likely bogged down: skipping rest of test", 1
+        if $! == Errno::EAGAIN();
+
+      die "Unable to start thread: $!";
+    };
+  }
+}
+
 ok(1, "past spawning");
 
 $_->join for @threads;