Commit | Line | Data |
474ab91c |
1 | use strict; |
474ab91c |
2 | use warnings; |
1346e22d |
3 | use Test::More; |
474ab91c |
4 | |
474ab91c |
5 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/}; |
474ab91c |
6 | |
7 | plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test' |
8 | . ' (note: creates and drops a table named artist!)' unless ($dsn && $user); |
9 | |
be21f2eb |
10 | # README: If you set the env var to a number greater than 10, |
11 | # we will use that many children |
12 | my $num_children = $ENV{DBICTEST_FORK_STRESS} || 1; |
1346e22d |
13 | if($num_children !~ /^[0-9]+$/ || $num_children < 10) { |
14 | $num_children = 10; |
15 | } |
16 | |
7d216b10 |
17 | plan tests => ($num_children*2) + 6; |
474ab91c |
18 | |
19 | use lib qw(t/lib); |
20 | |
21 | use_ok('DBICTest::Schema'); |
22 | |
1346e22d |
23 | my $schema = DBICTest::Schema->connection($dsn, $user, $pass, { AutoCommit => 1 }); |
474ab91c |
24 | |
1346e22d |
25 | my $parent_rs; |
474ab91c |
26 | |
27 | eval { |
1346e22d |
28 | my $dbh = $schema->storage->dbh; |
474ab91c |
29 | |
1346e22d |
30 | { |
31 | local $SIG{__WARN__} = sub {}; |
32 | eval { $dbh->do("DROP TABLE cd") }; |
a1cb5921 |
33 | $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 |
34 | } |
474ab91c |
35 | |
1346e22d |
36 | $schema->resultset('CD')->create({ title => 'vacation in antarctica', artist => 123, year => 1901 }); |
37 | $schema->resultset('CD')->create({ title => 'vacation in antarctica part 2', artist => 456, year => 1901 }); |
474ab91c |
38 | |
1346e22d |
39 | $parent_rs = $schema->resultset('CD')->search({ year => 1901 }); |
40 | $parent_rs->next; |
474ab91c |
41 | }; |
42 | ok(!$@) or diag "Creation eval failed: $@"; |
43 | |
649bfb8c |
44 | { |
45 | my $pid = fork; |
46 | if(!defined $pid) { |
47 | die "fork failed: $!"; |
48 | } |
49 | |
50 | if (!$pid) { |
51 | exit $schema->storage->connected ? 1 : 0; |
52 | } |
53 | |
54 | if (waitpid($pid, 0) == $pid) { |
55 | my $ex = $? >> 8; |
56 | ok($ex == 0, "storage->connected() returns false in child"); |
57 | exit $ex if $ex; # skip remaining tests |
58 | } |
59 | } |
60 | |
474ab91c |
61 | my @pids; |
62 | while(@pids < $num_children) { |
63 | |
64 | my $pid = fork; |
65 | if(!defined $pid) { |
66 | die "fork failed: $!"; |
67 | } |
68 | elsif($pid) { |
69 | push(@pids, $pid); |
1346e22d |
70 | next; |
474ab91c |
71 | } |
72 | |
73 | $pid = $$; |
474ab91c |
74 | |
7d216b10 |
75 | my $work = sub { |
76 | my $child_rs = $schema->resultset('CD')->search({ year => 1901 }); |
77 | my $row = $parent_rs->next; |
78 | $schema->resultset('CD')->create({ title => "test success $pid", artist => $pid, year => scalar(@pids) }) |
79 | if($row && $row->get_column('artist') =~ /^(?:123|456)$/); |
80 | }; |
81 | |
82 | # try with and without transactions |
83 | if ((@pids % 3) == 1) { |
84 | my $guard = $schema->txn_scope_guard; |
85 | $work->(); |
86 | $guard->commit; |
474ab91c |
87 | } |
7d216b10 |
88 | elsif ((@pids % 3) == 2) { |
89 | $schema->txn_do ($work); |
90 | } |
91 | else { |
92 | $work->(); |
93 | } |
94 | |
474ab91c |
95 | sleep(3); |
7d216b10 |
96 | exit 0; |
474ab91c |
97 | } |
98 | |
99 | ok(1, "past forking"); |
100 | |
7d216b10 |
101 | for (@pids) { |
102 | waitpid($_,0); |
103 | ok (! $?, "Child $_ exitted cleanly"); |
104 | }; |
474ab91c |
105 | |
106 | ok(1, "past waiting"); |
107 | |
108 | while(@pids) { |
109 | my $pid = pop(@pids); |
1346e22d |
110 | my $rs = $schema->resultset('CD')->search({ title => "test success $pid", artist => $pid, year => scalar(@pids) }); |
474ab91c |
111 | is($rs->next->get_column('artist'), $pid, "Child $pid successful"); |
112 | } |
113 | |
114 | ok(1, "Made it to the end"); |
115 | |
1346e22d |
116 | $schema->storage->dbh->do("DROP TABLE cd"); |