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