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