Pass the main rsrc in attrs, instead of trying to fish it out later
[dbsrgits/DBIx-Class-Historic.git] / t / 51threadnodb.t
CommitLineData
a4367b26 1use Config;
2BEGIN {
3 unless ($Config{useithreads}) {
4 print "1..0 # SKIP your perl does not support ithreads\n";
5 exit 0;
6 }
f15baf68 7
8 if ($INC{'Devel/Cover.pm'}) {
9 print "1..0 # SKIP Devel::Cover does not work with threads yet\n";
10 exit 0;
11 }
a4367b26 12}
13use threads;
14
15use strict;
16use warnings;
17use Test::More;
18
9dfb034f 19use lib qw(t/lib);
20use DBICTest;
21
a4367b26 22plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
23 if $] < '5.008005';
24
9dfb034f 25plan skip_all => 'Potential problems on Win32 Perl < 5.14 and Variable::Magic - investigation pending'
26 if $^O eq 'MSWin32' && $] < 5.014 && DBICTest::RunMode->is_plain;
a4367b26 27
28# README: If you set the env var to a number greater than 10,
29# we will use that many children
30my $num_children = $ENV{DBICTEST_THREAD_STRESS} || 1;
31if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
32 $num_children = 10;
33}
34
35my $schema = DBICTest->init_schema(no_deploy => 1);
36isa_ok ($schema, 'DBICTest::Schema');
37
38my @threads;
39push @threads, threads->create(sub {
40 my $rsrc = $schema->source('Artist');
41 undef $schema;
42 isa_ok ($rsrc->schema, 'DBICTest::Schema');
43 my $s2 = $rsrc->schema->clone;
44
45 sleep 1; # without this many tasty crashes
46}) for (1.. $num_children);
47ok(1, "past spawning");
48
49$_->join for @threads;
50ok(1, "past joining");
51
52done_testing;