'undef =>' isn't what one would want
[dbsrgits/DBIx-Class-Historic.git] / t / 51threadnodb.t
1 use Config;
2 BEGIN {
3   unless ($Config{useithreads}) {
4     print "1..0 # SKIP your perl does not support ithreads\n";
5     exit 0;
6   }
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   }
12 }
13 use threads;
14
15 use strict;
16 use warnings;
17 use Test::More;
18
19 use lib qw(t/lib);
20 use DBICTest;
21
22 plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
23   if $] < '5.008005';
24
25 plan 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;
27
28 # README: If you set the env var to a number greater than 10,
29 #   we will use that many children
30 my $num_children = $ENV{DBICTEST_THREAD_STRESS} || 1;
31 if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
32    $num_children = 10;
33 }
34
35 my $schema = DBICTest->init_schema(no_deploy => 1);
36 isa_ok ($schema, 'DBICTest::Schema');
37
38 my @threads;
39 push @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);
47 ok(1, "past spawning");
48
49 $_->join for @threads;
50 ok(1, "past joining");
51
52 done_testing;