Fix parsing DSN when the driver part includes DBI attributes
[dbsrgits/DBIx-Class.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 use DBIx::Class::_Util 'sigwarn_silencer';
19
20 use lib qw(t/lib);
21 use DBICTest;
22
23 plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
24   if $] < '5.008005';
25
26 plan skip_all => 'Potential problems on Win32 Perl < 5.14 and Variable::Magic - investigation pending'
27   if $^O eq 'MSWin32' && $] < 5.014 && DBICTest::RunMode->is_plain;
28
29 # README: If you set the env var to a number greater than 10,
30 #   we will use that many children
31 my $num_children = $ENV{DBICTEST_THREAD_STRESS} || 1;
32 if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
33    $num_children = 10;
34 }
35
36 my $schema = DBICTest->init_schema(no_deploy => 1);
37 isa_ok ($schema, 'DBICTest::Schema');
38
39 my @threads;
40 SKIP: {
41
42   local $SIG{__WARN__} = sigwarn_silencer( qr/Thread creation failed/i );
43
44   for (1.. $num_children) {
45     push @threads, threads->create(sub {
46       my $rsrc = $schema->source('Artist');
47       undef $schema;
48       isa_ok ($rsrc->schema, 'DBICTest::Schema');
49       my $s2 = $rsrc->schema->clone;
50
51       sleep 1;  # without this many tasty crashes
52     }) || do {
53       skip "EAGAIN encountered, your system is likely bogged down: skipping rest of test", 1
54         if $! == Errno::EAGAIN();
55
56       die "Unable to start thread: $!";
57     };
58   }
59 }
60
61 ok(1, "past spawning");
62
63 $_->join for @threads;
64 ok(1, "past joining");
65
66 done_testing;