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