Restructure thread/fork tests to run with maximum concurrency
[dbsrgits/DBIx-Class.git] / t / 50fork.t
CommitLineData
c0329273 1BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
cb551b07 2use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_pg';
3
474ab91c 4use strict;
474ab91c 5use warnings;
1346e22d 6use Test::More;
a2f22854 7use Test::Exception;
10dd5c05 8use Time::HiRes qw(time sleep);
c0329273 9
8d6b1478 10use DBICTest;
199fbc45 11
8d6b1478 12my $main_pid = $$;
13
10dd5c05 14# README: If you set the env var to a number greater than 5,
be21f2eb 15# we will use that many children
16my $num_children = $ENV{DBICTEST_FORK_STRESS} || 1;
10dd5c05 17if($num_children !~ /^[0-9]+$/ || $num_children < 5) {
18 $num_children = 5;
1346e22d 19}
20
cb551b07 21my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
6892eb09 22my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { AutoCommit => 1 });
474ab91c 23
1346e22d 24my $parent_rs;
474ab91c 25
26eval {
1346e22d 27 my $dbh = $schema->storage->dbh;
474ab91c 28
1346e22d 29 {
30 local $SIG{__WARN__} = sub {};
31 eval { $dbh->do("DROP TABLE cd") };
a1cb5921 32 $dbh->do("CREATE TABLE cd (cdid serial PRIMARY KEY, artist INTEGER NOT NULL UNIQUE, title VARCHAR(100) NOT NULL UNIQUE, year VARCHAR(100) NOT NULL, genreid INTEGER, single_track INTEGER);");
1346e22d 33 }
474ab91c 34
1346e22d 35 $schema->resultset('CD')->create({ title => 'vacation in antarctica', artist => 123, year => 1901 });
36 $schema->resultset('CD')->create({ title => 'vacation in antarctica part 2', artist => 456, year => 1901 });
474ab91c 37
1346e22d 38 $parent_rs = $schema->resultset('CD')->search({ year => 1901 });
a2f22854 39 is ($parent_rs->count, 2);
474ab91c 40};
41ok(!$@) or diag "Creation eval failed: $@";
42
a2f22854 43# basic tests
649bfb8c 44{
a2f22854 45 ok ($schema->storage->connected(), 'Parent is connected');
46 is ($parent_rs->next->id, 1, 'Cursor advanced');
47
48 my ($parent_in, $child_out);
49 pipe( $parent_in, $child_out ) or die "Pipe open failed: $!";
50
51 my $pid = fork;
52 if(!defined $pid) {
53 die "fork failed: $!";
54 }
55
56 if (!$pid) {
57 close $parent_in;
58
59 #simulate a subtest to not confuse the parent TAP emission
60 my $tb = Test::More->builder;
61 $tb->reset;
62 for (qw/output failure_output todo_output/) {
63 close $tb->$_;
64 open ($tb->$_, '>&', $child_out);
649bfb8c 65 }
66
a2f22854 67 ok(!$schema->storage->connected, "storage->connected() false in child");
68 for (1,2) {
69 throws_ok { $parent_rs->next } qr/\QMulti-process access attempted while cursor in progress (position 1)/;
649bfb8c 70 }
71
a2f22854 72 $parent_rs->reset;
73 is($parent_rs->next->id, 1, 'Resetting cursor reprepares it within child environment');
74
75 done_testing;
76 exit 0;
77 }
78
79 close $child_out;
80 while (my $ln = <$parent_in>) {
81 print " $ln";
82 }
83 waitpid( $pid, 0 );
84 ok(!$?, 'Child subtests passed');
85
86 is ($parent_rs->next->id, 2, 'Cursor still intact in parent');
87 is ($parent_rs->next, undef, 'Cursor exhausted');
649bfb8c 88}
89
a2f22854 90$parent_rs->reset;
10dd5c05 91
92# sleep until this spot so everything starts simultaneously
93# add "until turn of second" for prettier display
94my $t = int( time() ) + 4;
95
474ab91c 96my @pids;
97while(@pids < $num_children) {
98
99 my $pid = fork;
100 if(!defined $pid) {
101 die "fork failed: $!";
102 }
103 elsif($pid) {
104 push(@pids, $pid);
1346e22d 105 next;
474ab91c 106 }
107
108 $pid = $$;
474ab91c 109
10dd5c05 110 sleep ( $t - time );
111 note ("Child process $pid starting work at " . time() );
112
7d216b10 113 my $work = sub {
114 my $child_rs = $schema->resultset('CD')->search({ year => 1901 });
115 my $row = $parent_rs->next;
116 $schema->resultset('CD')->create({ title => "test success $pid", artist => $pid, year => scalar(@pids) })
117 if($row && $row->get_column('artist') =~ /^(?:123|456)$/);
118 };
119
120 # try with and without transactions
121 if ((@pids % 3) == 1) {
122 my $guard = $schema->txn_scope_guard;
123 $work->();
124 $guard->commit;
474ab91c 125 }
7d216b10 126 elsif ((@pids % 3) == 2) {
127 $schema->txn_do ($work);
128 }
129 else {
130 $work->();
131 }
132
10dd5c05 133 sleep(2);
7d216b10 134 exit 0;
474ab91c 135}
136
137ok(1, "past forking");
138
7d216b10 139for (@pids) {
140 waitpid($_,0);
141 ok (! $?, "Child $_ exitted cleanly");
142};
474ab91c 143
144ok(1, "past waiting");
145
146while(@pids) {
147 my $pid = pop(@pids);
1346e22d 148 my $rs = $schema->resultset('CD')->search({ title => "test success $pid", artist => $pid, year => scalar(@pids) });
474ab91c 149 is($rs->next->get_column('artist'), $pid, "Child $pid successful");
150}
151
152ok(1, "Made it to the end");
153
8d6b1478 154done_testing;
155
156END {
157 $schema->storage->dbh->do("DROP TABLE cd") if ($schema and $main_pid == $$);
158 undef $schema;
159}