Commit | Line | Data |
70350518 |
1 | use strict; |
d7ded411 |
2 | use warnings; |
70350518 |
3 | |
4 | use Test::More; |
d7ded411 |
5 | use Test::Warn; |
3b7f3eac |
6 | use Test::Exception; |
70350518 |
7 | use lib qw(t/lib); |
8 | use DBICTest; |
9 | |
a62cf8d4 |
10 | my $code = sub { |
11 | my ($artist, @cd_titles) = @_; |
d7ded411 |
12 | |
a62cf8d4 |
13 | $artist->create_related('cds', { |
14 | title => $_, |
15 | year => 2006, |
16 | }) foreach (@cd_titles); |
d7ded411 |
17 | |
0e7a447e |
18 | return $artist->cds->all; |
a62cf8d4 |
19 | }; |
20 | |
171dadd7 |
21 | # Test checking of parameters |
22 | { |
471a5fdd |
23 | my $schema = DBICTest->init_schema; |
24 | |
dd7d4b43 |
25 | throws_ok (sub { |
171dadd7 |
26 | (ref $schema)->txn_do(sub{}); |
dd7d4b43 |
27 | }, qr/storage/, "can't call txn_do without storage"); |
28 | |
29 | throws_ok ( sub { |
171dadd7 |
30 | $schema->txn_do(''); |
dd7d4b43 |
31 | }, qr/must be a CODE reference/, '$coderef parameter check ok'); |
171dadd7 |
32 | } |
33 | |
471a5fdd |
34 | # Test successful txn_do() - scalar/list context |
35 | for my $want (0,1) { |
36 | my $schema = DBICTest->init_schema; |
37 | |
57c18b65 |
38 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
39 | |
a62cf8d4 |
40 | my @titles = map {'txn_do test CD ' . $_} (1..5); |
41 | my $artist = $schema->resultset('Artist')->find(1); |
42 | my $count_before = $artist->cds->count; |
a62cf8d4 |
43 | |
471a5fdd |
44 | my @res; |
45 | if ($want) { |
46 | @res = $schema->txn_do($code, $artist, @titles); |
47 | is(scalar @res, $count_before+5, 'successful txn added 5 cds'); |
48 | } |
49 | else { |
50 | $res[0] = $schema->txn_do($code, $artist, @titles); |
51 | is($res[0], $count_before+5, 'successful txn added 5 cds'); |
52 | } |
57c18b65 |
53 | |
a62cf8d4 |
54 | is($artist->cds({ |
55 | title => "txn_do test CD $_", |
471a5fdd |
56 | })->first->year, 2006, "new CD $_ year correct") for (1..5); |
57c18b65 |
57 | |
58 | is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); |
a62cf8d4 |
59 | } |
60 | |
38ed54cd |
61 | # Test txn_do() @_ aliasing support |
62 | { |
471a5fdd |
63 | my $schema = DBICTest->init_schema; |
64 | |
38ed54cd |
65 | my $res = 'original'; |
66 | $schema->storage->txn_do (sub { $_[0] = 'changed' }, $res); |
67 | is ($res, 'changed', "Arguments properly aliased for txn_do"); |
68 | } |
69 | |
a62cf8d4 |
70 | # Test nested successful txn_do() |
71 | { |
471a5fdd |
72 | my $schema = DBICTest->init_schema; |
73 | |
57c18b65 |
74 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
75 | |
a62cf8d4 |
76 | my $nested_code = sub { |
77 | my ($schema, $artist, $code) = @_; |
78 | |
79 | my @titles1 = map {'nested txn_do test CD ' . $_} (1..5); |
80 | my @titles2 = map {'nested txn_do test CD ' . $_} (6..10); |
81 | |
82 | $schema->txn_do($code, $artist, @titles1); |
83 | $schema->txn_do($code, $artist, @titles2); |
84 | }; |
85 | |
86 | my $artist = $schema->resultset('Artist')->find(2); |
87 | my $count_before = $artist->cds->count; |
88 | |
dd7d4b43 |
89 | lives_ok (sub { |
a62cf8d4 |
90 | $schema->txn_do($nested_code, $schema, $artist, $code); |
dd7d4b43 |
91 | }, 'nested txn_do succeeded'); |
a62cf8d4 |
92 | |
a62cf8d4 |
93 | is($artist->cds({ |
94 | title => 'nested txn_do test CD '.$_, |
95 | })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10); |
96 | is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs'); |
57c18b65 |
97 | |
98 | is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); |
a62cf8d4 |
99 | } |
100 | |
7d216b10 |
101 | # test nested txn_begin on fresh connection |
102 | { |
103 | my $schema = DBICTest->init_schema(sqlite_use_file => 1, no_deploy => 1); |
104 | $schema->storage->ensure_connected; |
105 | |
106 | is ($schema->storage->transaction_depth, 0, 'Start outside txn'); |
107 | |
108 | my @pids; |
109 | for my $action ( |
110 | sub { |
111 | my $s = shift; |
112 | die "$$ starts in txn!" if $s->storage->transaction_depth != 0; |
113 | $s->txn_do ( sub { |
114 | die "$$ not in txn!" if $s->storage->transaction_depth == 0; |
115 | $s->storage->dbh->do('SELECT 1') } |
116 | ); |
117 | die "$$ did not finish txn!" if $s->storage->transaction_depth != 0; |
118 | }, |
119 | sub { |
120 | $_[0]->txn_begin; |
121 | $_[0]->storage->dbh->do('SELECT 1'); |
122 | $_[0]->txn_commit |
123 | }, |
124 | sub { |
125 | my $guard = $_[0]->txn_scope_guard; |
126 | $_[0]->storage->dbh->do('SELECT 1'); |
127 | $guard->commit |
128 | }, |
129 | ) { |
ec6415a9 |
130 | my $pid = fork(); |
7d216b10 |
131 | die "Unable to fork: $!\n" |
ec6415a9 |
132 | if ! defined $pid; |
7d216b10 |
133 | |
ec6415a9 |
134 | if ($pid) { |
135 | push @pids, $pid; |
7d216b10 |
136 | next; |
137 | } |
138 | |
139 | $action->($schema); |
140 | exit 0; |
141 | } |
142 | |
143 | is ($schema->storage->transaction_depth, 0, 'Parent still outside txn'); |
144 | |
145 | for my $pid (@pids) { |
146 | waitpid ($pid, 0); |
147 | ok (! $?, "Child $pid exit ok"); |
148 | } |
149 | } |
150 | |
151 | # Test txn_do/scope_guard with forking: outer txn_do |
152 | { |
153 | my $schema = DBICTest->init_schema( sqlite_use_file => 1 ); |
154 | |
155 | for my $pass (1..2) { |
156 | |
157 | # do something trying to destabilize the depth count |
158 | for (1..2) { |
159 | eval { |
160 | my $guard = $schema->txn_scope_guard; |
161 | $schema->txn_do( sub { die } ); |
162 | }; |
90d7422f |
163 | is( $schema->storage->transaction_depth, 0, 'Transaction successfully aborted' ); |
7d216b10 |
164 | $schema->txn_do( sub { |
165 | ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)"); |
166 | }); |
167 | } |
168 | |
ec6415a9 |
169 | $schema->txn_do ( sub { _test_forking_action ($schema, $pass) } ); |
7d216b10 |
170 | } |
171 | } |
172 | |
173 | # same test with outer guard |
174 | { |
175 | my $schema = DBICTest->init_schema( sqlite_use_file => 1 ); |
176 | |
177 | for my $pass (1..2) { |
178 | |
179 | # do something trying to destabilize the depth count |
180 | for (1..2) { |
181 | eval { |
182 | my $guard = $schema->txn_scope_guard; |
183 | $schema->txn_do( sub { die } ); |
184 | }; |
90d7422f |
185 | is( $schema->storage->transaction_depth, 0, 'Transaction successfully aborted' ); |
7d216b10 |
186 | $schema->txn_do( sub { |
187 | ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)"); |
188 | }); |
189 | } |
190 | |
7d216b10 |
191 | my $guard = $schema->txn_scope_guard; |
ec6415a9 |
192 | my @pids = _test_forking_action ($schema, $pass); |
7d216b10 |
193 | $guard->commit; |
7d216b10 |
194 | } |
195 | } |
196 | |
ec6415a9 |
197 | sub _test_forking_action { |
198 | my ($schema, $pass) = @_; |
7d216b10 |
199 | |
200 | my @pids; |
7d216b10 |
201 | |
ec6415a9 |
202 | SKIP: for my $count (1 .. 5) { |
203 | |
204 | skip 'Weird DBI General Protection Faults, skip forking tests (RT#63104)', 5 |
205 | if $^O eq 'MSWin32'; |
206 | |
207 | my $pid = fork(); |
7d216b10 |
208 | die "Unable to fork: $!\n" |
ec6415a9 |
209 | if ! defined $pid; |
7d216b10 |
210 | |
ec6415a9 |
211 | if ($pid) { |
212 | push @pids, $pid; |
7d216b10 |
213 | next; |
214 | } |
215 | |
ec6415a9 |
216 | if ($count % 2) { |
7d216b10 |
217 | $schema->txn_do (sub { |
218 | my $depth = $schema->storage->transaction_depth; |
219 | die "$$(txn_do)unexpected txn depth $depth!" if $depth != 1; |
220 | $schema->resultset ('Artist')->create ({ name => "forking action $$"}); |
221 | }); |
222 | } |
223 | else { |
224 | my $guard = $schema->txn_scope_guard; |
225 | my $depth = $schema->storage->transaction_depth; |
226 | die "$$(scope_guard) unexpected txn depth $depth!" if $depth != 1; |
227 | $schema->resultset ('Artist')->create ({ name => "forking action $$"}); |
228 | $guard->commit; |
229 | } |
230 | |
231 | exit 0; |
232 | } |
233 | |
ec6415a9 |
234 | for my $pid (@pids) { |
235 | waitpid ($pid, 0); |
236 | ok (! $?, "Child $pid exit ok (pass $pass)"); |
02050e77 |
237 | } |
238 | |
239 | # it is important to reap all children before checking the final db-state |
240 | # otherwise a deadlock may occur between the transactions running in the |
241 | # children and the query of the parent |
242 | for my $pid (@pids) { |
ec6415a9 |
243 | isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row'); |
244 | } |
7d216b10 |
245 | } |
246 | |
a62cf8d4 |
247 | my $fail_code = sub { |
248 | my ($artist) = @_; |
249 | $artist->create_related('cds', { |
250 | title => 'this should not exist', |
251 | year => 2005, |
252 | }); |
253 | die "the sky is falling"; |
254 | }; |
255 | |
a62cf8d4 |
256 | { |
471a5fdd |
257 | my $schema = DBICTest->init_schema; |
57c18b65 |
258 | |
471a5fdd |
259 | # Test failed txn_do() |
260 | for my $pass (1,2) { |
57c18b65 |
261 | |
471a5fdd |
262 | is( $schema->storage->{transaction_depth}, 0, "txn depth starts at 0 (pass $pass)"); |
a62cf8d4 |
263 | |
471a5fdd |
264 | my $artist = $schema->resultset('Artist')->find(3); |
a62cf8d4 |
265 | |
471a5fdd |
266 | throws_ok (sub { |
267 | $schema->txn_do($fail_code, $artist); |
268 | }, qr/the sky is falling/, "failed txn_do threw an exception (pass $pass)"); |
57c18b65 |
269 | |
471a5fdd |
270 | my $cd = $artist->cds({ |
271 | title => 'this should not exist', |
272 | year => 2005, |
273 | })->first; |
274 | ok(!defined($cd), qq{failed txn_do didn't change the cds table (pass $pass)}); |
a62cf8d4 |
275 | |
471a5fdd |
276 | is( $schema->storage->{transaction_depth}, 0, "txn depth has been reset (pass $pass)"); |
277 | } |
57c18b65 |
278 | |
a62cf8d4 |
279 | |
471a5fdd |
280 | # Test failed txn_do() with failed rollback |
281 | { |
282 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
57c18b65 |
283 | |
471a5fdd |
284 | my $artist = $schema->resultset('Artist')->find(3); |
a62cf8d4 |
285 | |
471a5fdd |
286 | # Force txn_rollback() to throw an exception |
90d7422f |
287 | no warnings qw/once redefine/; |
288 | |
289 | # this should logically work just fine - but it does not, |
290 | # only direct override of the existing method dtrt |
291 | #local *DBIx::Class::Storage::DBI::SQLite::txn_rollback = sub { die 'FAILED' }; |
a62cf8d4 |
292 | |
90d7422f |
293 | local *DBIx::Class::Storage::DBI::txn_rollback = sub { die 'FAILED' }; |
294 | Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO; |
d9c17594 |
295 | |
471a5fdd |
296 | throws_ok ( |
297 | sub { |
298 | $schema->txn_do($fail_code, $artist); |
299 | }, |
300 | qr/the sky is falling.+Rollback failed/s, |
301 | 'txn_rollback threw a rollback exception (and included the original exception' |
302 | ); |
303 | |
304 | my $cd = $artist->cds({ |
305 | title => 'this should not exist', |
306 | year => 2005, |
307 | })->first; |
308 | isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }. |
309 | q{changed the cds table}); |
310 | $cd->delete; # Rollback failed |
311 | $cd = $artist->cds({ |
312 | title => 'this should not exist', |
313 | year => 2005, |
314 | })->first; |
315 | ok(!defined($cd), q{deleted the failed txn's cd}); |
316 | $schema->storage->_dbh->rollback; |
317 | } |
a62cf8d4 |
318 | } |
319 | |
320 | # Test nested failed txn_do() |
321 | { |
d9c17594 |
322 | my $schema = DBICTest->init_schema(); |
323 | |
57c18b65 |
324 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
325 | |
a62cf8d4 |
326 | my $nested_fail_code = sub { |
327 | my ($schema, $artist, $code1, $code2) = @_; |
328 | |
329 | my @titles = map {'nested txn_do test CD ' . $_} (1..5); |
330 | |
331 | $schema->txn_do($code1, $artist, @titles); # successful txn |
332 | $schema->txn_do($code2, $artist); # failed txn |
333 | }; |
334 | |
335 | my $artist = $schema->resultset('Artist')->find(3); |
336 | |
dd7d4b43 |
337 | throws_ok ( sub { |
a62cf8d4 |
338 | $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code); |
dd7d4b43 |
339 | }, qr/the sky is falling/, 'nested failed txn_do threw exception'); |
a62cf8d4 |
340 | |
a62cf8d4 |
341 | ok(!defined($artist->cds({ |
342 | title => 'nested txn_do test CD '.$_, |
343 | year => 2006, |
344 | })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5); |
345 | my $cd = $artist->cds({ |
346 | title => 'this should not exist', |
347 | year => 2005, |
348 | })->first; |
349 | ok(!defined($cd), q{failed txn_do didn't add failed txn's cd}); |
350 | } |
a62cf8d4 |
351 | |
90d7422f |
352 | |
291bf95f |
353 | # Grab a new schema to test txn before connect |
90d7422f |
354 | # also test nested txn exception |
291bf95f |
355 | { |
d9c17594 |
356 | my $schema = DBICTest->init_schema(no_deploy => 1); |
357 | lives_ok (sub { |
358 | $schema->txn_begin(); |
359 | $schema->txn_begin(); |
360 | }, 'Pre-connection nested transactions.'); |
361 | |
90d7422f |
362 | throws_ok( sub { $schema->txn_rollback }, 'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION', 'got proper nested rollback exception' ); |
291bf95f |
363 | } |
3b7f3eac |
364 | |
257a1d3b |
365 | # make sure AutoCommit => 0 on external handles behaves correctly with scope_guard |
cf31592c |
366 | warnings_are { |
6c925c72 |
367 | my $factory = DBICTest->init_schema; |
257a1d3b |
368 | cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete'); |
369 | my $dbh = $factory->storage->dbh; |
6c925c72 |
370 | $dbh->{AutoCommit} = 0; |
257a1d3b |
371 | |
372 | ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh'); |
373 | my $schema = DBICTest::Schema->connect (sub { $dbh }); |
374 | |
257a1d3b |
375 | lives_ok ( sub { |
376 | my $guard = $schema->txn_scope_guard; |
377 | $schema->resultset('CD')->delete; |
378 | $guard->commit; |
379 | }, 'No attempt to start a transaction with scope guard'); |
380 | |
cf31592c |
381 | is ($schema->resultset('CD')->count, 0, 'Deletion successful in txn'); |
382 | |
383 | # this will commit the implicitly started txn |
384 | $dbh->commit; |
385 | |
386 | } [], 'No warnings on AutoCommit => 0 with txn_guard'; |
257a1d3b |
387 | |
388 | # make sure AutoCommit => 0 on external handles behaves correctly with txn_do |
cf31592c |
389 | warnings_are { |
6c925c72 |
390 | my $factory = DBICTest->init_schema; |
257a1d3b |
391 | cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete'); |
392 | my $dbh = $factory->storage->dbh; |
6c925c72 |
393 | $dbh->{AutoCommit} = 0; |
257a1d3b |
394 | |
395 | ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh'); |
396 | my $schema = DBICTest::Schema->connect (sub { $dbh }); |
397 | |
257a1d3b |
398 | lives_ok ( sub { |
399 | $schema->txn_do (sub { $schema->resultset ('CD')->delete }); |
400 | }, 'No attempt to start a atransaction with txn_do'); |
401 | |
402 | is ($schema->resultset('CD')->count, 0, 'Deletion successful'); |
cf31592c |
403 | |
404 | # this will commit the implicitly started txn |
405 | $dbh->commit; |
406 | |
407 | } [], 'No warnings on AutoCommit => 0 with txn_do'; |
257a1d3b |
408 | |
d7ded411 |
409 | done_testing; |