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