Restore ability to handle underdefined root (t/prefetch/incomplete.t)
[dbsrgits/DBIx-Class.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 }
7}
8use threads;
9
10use strict;
11use warnings;
12use Test::More;
13
9dfb034f 14use lib qw(t/lib);
15use DBICTest;
16
a4367b26 17plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
18 if $] < '5.008005';
19
9dfb034f 20plan skip_all => 'Potential problems on Win32 Perl < 5.14 and Variable::Magic - investigation pending'
21 if $^O eq 'MSWin32' && $] < 5.014 && DBICTest::RunMode->is_plain;
a4367b26 22
23# README: If you set the env var to a number greater than 10,
24# we will use that many children
25my $num_children = $ENV{DBICTEST_THREAD_STRESS} || 1;
26if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
27 $num_children = 10;
28}
29
30my $schema = DBICTest->init_schema(no_deploy => 1);
31isa_ok ($schema, 'DBICTest::Schema');
32
33my @threads;
34push @threads, threads->create(sub {
35 my $rsrc = $schema->source('Artist');
36 undef $schema;
37 isa_ok ($rsrc->schema, 'DBICTest::Schema');
38 my $s2 = $rsrc->schema->clone;
39
40 sleep 1; # without this many tasty crashes
41}) for (1.. $num_children);
42ok(1, "past spawning");
43
44$_->join for @threads;
45ok(1, "past joining");
46
47done_testing;