Merge branch 'master' into topic/constructor_rewrite

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

diff --git a/t/51threadnodb.t b/t/51threadnodb.t
new file mode 100644 (file)
index 0000000..52cdcd8
--- /dev/null
+++ b/t/51threadnodb.t
@@ -0,0 +1,44 @@
+use Config;
+BEGIN {
+  unless ($Config{useithreads}) {
+    print "1..0 # SKIP your perl does not support ithreads\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 lib qw(t/lib);
+use DBICTest;
+
+# 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;
+if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
+   $num_children = 10;
+}
+
+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);
+ok(1, "past spawning");
+
+$_->join for @threads;
+ok(1, "past joining");
+
+done_testing;