Commit | Line | Data |
c0329273 |
1 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
2 | |
a4367b26 |
3 | use Config; |
4 | BEGIN { |
5 | unless ($Config{useithreads}) { |
6 | print "1..0 # SKIP your perl does not support ithreads\n"; |
7 | exit 0; |
8 | } |
f15baf68 |
9 | |
10 | if ($INC{'Devel/Cover.pm'}) { |
11 | print "1..0 # SKIP Devel::Cover does not work with threads yet\n"; |
12 | exit 0; |
13 | } |
a4367b26 |
14 | } |
15 | use threads; |
16 | |
17 | use strict; |
18 | use warnings; |
19 | use Test::More; |
e48635f7 |
20 | use Errno (); |
c5915b45 |
21 | use DBIx::Class::_Util 'sigwarn_silencer'; |
a4367b26 |
22 | |
9dfb034f |
23 | use DBICTest; |
24 | |
a4367b26 |
25 | plan skip_all => 'DBIC does not actively support threads before perl 5.8.5' |
750a4ad2 |
26 | if "$]" < 5.008005; |
a4367b26 |
27 | |
9dfb034f |
28 | plan skip_all => 'Potential problems on Win32 Perl < 5.14 and Variable::Magic - investigation pending' |
750a4ad2 |
29 | if $^O eq 'MSWin32' && "$]" < 5.014 && DBICTest::RunMode->is_plain; |
a4367b26 |
30 | |
31 | # README: If you set the env var to a number greater than 10, |
32 | # we will use that many children |
33 | my $num_children = $ENV{DBICTEST_THREAD_STRESS} || 1; |
34 | if($num_children !~ /^[0-9]+$/ || $num_children < 10) { |
35 | $num_children = 10; |
36 | } |
37 | |
38 | my $schema = DBICTest->init_schema(no_deploy => 1); |
39 | isa_ok ($schema, 'DBICTest::Schema'); |
40 | |
41 | my @threads; |
c5915b45 |
42 | SKIP: { |
43 | |
44 | local $SIG{__WARN__} = sigwarn_silencer( qr/Thread creation failed/i ); |
45 | |
46 | for (1.. $num_children) { |
47 | push @threads, threads->create(sub { |
48 | my $rsrc = $schema->source('Artist'); |
49 | undef $schema; |
50 | isa_ok ($rsrc->schema, 'DBICTest::Schema'); |
51 | my $s2 = $rsrc->schema->clone; |
52 | |
53 | sleep 1; # without this many tasty crashes |
54 | }) || do { |
55 | skip "EAGAIN encountered, your system is likely bogged down: skipping rest of test", 1 |
56 | if $! == Errno::EAGAIN(); |
57 | |
58 | die "Unable to start thread: $!"; |
59 | }; |
60 | } |
61 | } |
62 | |
a4367b26 |
63 | ok(1, "past spawning"); |
64 | |
65 | $_->join for @threads; |
66 | ok(1, "past joining"); |
67 | |
68 | done_testing; |