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