Fix forgotten external-$dbh test warnings
[dbsrgits/DBIx-Class.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
a47e1233 10my $schema = DBICTest->init_schema();
70350518 11
a62cf8d4 12my $code = sub {
13 my ($artist, @cd_titles) = @_;
d7ded411 14
a62cf8d4 15 $artist->create_related('cds', {
16 title => $_,
17 year => 2006,
18 }) foreach (@cd_titles);
d7ded411 19
a62cf8d4 20 return $artist->cds->all;
21};
22
171dadd7 23# Test checking of parameters
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
a62cf8d4 34# Test successful txn_do() - scalar context
35{
57c18b65 36 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
37
a62cf8d4 38 my @titles = map {'txn_do test CD ' . $_} (1..5);
39 my $artist = $schema->resultset('Artist')->find(1);
40 my $count_before = $artist->cds->count;
41 my $count_after = $schema->txn_do($code, $artist, @titles);
42 is($count_after, $count_before+5, 'successful txn added 5 cds');
43 is($artist->cds({
44 title => "txn_do test CD $_",
45 })->first->year, 2006, "new CD $_ year correct") for (1..5);
57c18b65 46
47 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
a62cf8d4 48}
49
50# Test successful txn_do() - list context
51{
57c18b65 52 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
53
a62cf8d4 54 my @titles = map {'txn_do test CD ' . $_} (6..10);
55 my $artist = $schema->resultset('Artist')->find(1);
56 my $count_before = $artist->cds->count;
57 my @cds = $schema->txn_do($code, $artist, @titles);
58 is(scalar @cds, $count_before+5, 'added 5 CDs and returned in list context');
59 is($artist->cds({
60 title => "txn_do test CD $_",
61 })->first->year, 2006, "new CD $_ year correct") for (6..10);
57c18b65 62
63 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
a62cf8d4 64}
65
38ed54cd 66# Test txn_do() @_ aliasing support
67{
68 my $res = 'original';
69 $schema->storage->txn_do (sub { $_[0] = 'changed' }, $res);
70 is ($res, 'changed', "Arguments properly aliased for txn_do");
71}
72
a62cf8d4 73# Test nested successful txn_do()
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
102my $fail_code = sub {
103 my ($artist) = @_;
104 $artist->create_related('cds', {
105 title => 'this should not exist',
106 year => 2005,
107 });
108 die "the sky is falling";
109};
110
111# Test failed txn_do()
112{
57c18b65 113
114 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
115
116 my $artist = $schema->resultset('Artist')->find(3);
117
dd7d4b43 118 throws_ok (sub {
57c18b65 119 $schema->txn_do($fail_code, $artist);
dd7d4b43 120 }, qr/the sky is falling/, 'failed txn_do threw an exception');
57c18b65 121
57c18b65 122 my $cd = $artist->cds({
123 title => 'this should not exist',
124 year => 2005,
125 })->first;
126 ok(!defined($cd), q{failed txn_do didn't change the cds table});
127
128 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
129}
130
131# do the same transaction again
132{
133 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
134
a62cf8d4 135 my $artist = $schema->resultset('Artist')->find(3);
136
dd7d4b43 137 throws_ok (sub {
a62cf8d4 138 $schema->txn_do($fail_code, $artist);
dd7d4b43 139 }, qr/the sky is falling/, 'failed txn_do threw an exception');
a62cf8d4 140
a62cf8d4 141 my $cd = $artist->cds({
142 title => 'this should not exist',
143 year => 2005,
144 })->first;
145 ok(!defined($cd), q{failed txn_do didn't change the cds table});
57c18b65 146
147 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
a62cf8d4 148}
149
150# Test failed txn_do() with failed rollback
151{
57c18b65 152 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
153
a62cf8d4 154 my $artist = $schema->resultset('Artist')->find(3);
155
156 # Force txn_rollback() to throw an exception
157 no warnings 'redefine';
58d387fe 158 no strict 'refs';
57c18b65 159
fb61e30c 160 # die in rollback
57c18b65 161 local *{"DBIx::Class::Storage::DBI::SQLite::txn_rollback"} = sub{
162 my $storage = shift;
57c18b65 163 die 'FAILED';
164 };
a62cf8d4 165
dd7d4b43 166 throws_ok (
167 sub {
168 $schema->txn_do($fail_code, $artist);
169 },
170 qr/the sky is falling.+Rollback failed/s,
171 'txn_rollback threw a rollback exception (and included the original exception'
172 );
a62cf8d4 173
174 my $cd = $artist->cds({
175 title => 'this should not exist',
176 year => 2005,
177 })->first;
178 isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }.
179 q{changed the cds table});
180 $cd->delete; # Rollback failed
181 $cd = $artist->cds({
182 title => 'this should not exist',
183 year => 2005,
184 })->first;
185 ok(!defined($cd), q{deleted the failed txn's cd});
57c18b65 186 $schema->storage->_dbh->rollback;
a62cf8d4 187}
188
fb61e30c 189# reset schema object (the txn_rollback meddling screws it up)
190$schema = DBICTest->init_schema();
191
a62cf8d4 192# Test nested failed txn_do()
193{
57c18b65 194 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
195
a62cf8d4 196 my $nested_fail_code = sub {
197 my ($schema, $artist, $code1, $code2) = @_;
198
199 my @titles = map {'nested txn_do test CD ' . $_} (1..5);
200
201 $schema->txn_do($code1, $artist, @titles); # successful txn
202 $schema->txn_do($code2, $artist); # failed txn
203 };
204
205 my $artist = $schema->resultset('Artist')->find(3);
206
dd7d4b43 207 throws_ok ( sub {
a62cf8d4 208 $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
dd7d4b43 209 }, qr/the sky is falling/, 'nested failed txn_do threw exception');
a62cf8d4 210
a62cf8d4 211 ok(!defined($artist->cds({
212 title => 'nested txn_do test CD '.$_,
213 year => 2006,
214 })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5);
215 my $cd = $artist->cds({
216 title => 'this should not exist',
217 year => 2005,
218 })->first;
219 ok(!defined($cd), q{failed txn_do didn't add failed txn's cd});
220}
a62cf8d4 221
291bf95f 222# Grab a new schema to test txn before connect
223{
224 my $schema2 = DBICTest->init_schema(no_deploy => 1);
dd7d4b43 225 lives_ok (sub {
291bf95f 226 $schema2->txn_begin();
227 $schema2->txn_begin();
dd7d4b43 228 }, 'Pre-connection nested transactions.');
c52c3466 229
230 # although not connected DBI would still warn about rolling back at disconnect
231 $schema2->txn_rollback;
232 $schema2->txn_rollback;
a211cb63 233 $schema2->storage->disconnect;
291bf95f 234}
a211cb63 235$schema->storage->disconnect;
3b7f3eac 236
3b7f3eac 237# Test txn_scope_guard
238{
3b7f3eac 239 my $schema = DBICTest->init_schema();
240
241 is($schema->storage->transaction_depth, 0, "Correct transaction depth");
242 my $artist_rs = $schema->resultset('Artist');
38ed54cd 243 my $fn = __FILE__;
3b7f3eac 244 throws_ok {
245 my $guard = $schema->txn_scope_guard;
246
247
248 $artist_rs->create({
249 name => 'Death Cab for Cutie',
250 made_up_column => 1,
251 });
d7ded411 252
3b7f3eac 253 $guard->commit;
38ed54cd 254 } qr/No such column made_up_column .*? at .*?$fn line \d+/s, "Error propogated okay";
3b7f3eac 255
256 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
257
dd7d4b43 258 my $inner_exception = ''; # set in inner() below
259 throws_ok (sub {
3b7f3eac 260 outer($schema, 1);
dd7d4b43 261 }, qr/$inner_exception/, "Nested exceptions propogated");
3b7f3eac 262
263 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
264
aab0d3b7 265 lives_ok (sub {
d7ded411 266 warnings_exist ( sub {
257a1d3b 267 # The 0 arg says don't die, just let the scope guard go out of scope
d7ded411 268 # forcing a txn_rollback to happen
269 outer($schema, 0);
771298cf 270 }, qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, 'Out of scope warning detected');
aab0d3b7 271 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
272 }, 'rollback successful withot exception');
3b7f3eac 273
274 sub outer {
275 my ($schema) = @_;
aab0d3b7 276
3b7f3eac 277 my $guard = $schema->txn_scope_guard;
278 $schema->resultset('Artist')->create({
279 name => 'Death Cab for Cutie',
280 });
281 inner(@_);
3b7f3eac 282 }
283
284 sub inner {
285 my ($schema, $fatal) = @_;
aab0d3b7 286
287 my $inner_guard = $schema->txn_scope_guard;
288 is($schema->storage->transaction_depth, 2, "Correct transaction depth");
3b7f3eac 289
290 my $artist = $artist_rs->find({ name => 'Death Cab for Cutie' });
291
3b7f3eac 292 eval {
257a1d3b 293 $artist->cds->create({
3b7f3eac 294 title => 'Plans',
257a1d3b 295 year => 2005,
3b7f3eac 296 $fatal ? ( foo => 'bar' ) : ()
297 });
298 };
299 if ($@) {
300 # Record what got thrown so we can test it propgates out properly.
301 $inner_exception = $@;
302 die $@;
303 }
304
aab0d3b7 305 # inner guard should commit without consequences
306 $inner_guard->commit;
3b7f3eac 307 }
308}
d7ded411 309
310# make sure the guard does not eat exceptions
311{
312 my $schema = DBICTest->init_schema();
313 throws_ok (sub {
314 my $guard = $schema->txn_scope_guard;
315 $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
316
317 $schema->storage->disconnect; # this should freak out the guard rollback
318
319 die 'Deliberate exception';
320 }, qr/Deliberate exception.+Rollback failed/s);
321}
322
83f26263 323# make sure it warns *big* on failed rollbacks
324{
c6e27318 325 my $schema = DBICTest->init_schema();
c6e27318 326
36099e8c 327 # something is really confusing Test::Warn here, no time to debug
328=begin
329 warnings_exist (
330 sub {
771298cf 331 my $guard = $schema->txn_scope_guard;
332 $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
333
334 $schema->storage->disconnect; # this should freak out the guard rollback
771298cf 335 },
83f26263 336 [
337 qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./,
338 qr/\*+ ROLLBACK FAILED\!\!\! \*+/,
339 ],
340 'proper warnings generated on out-of-scope+rollback failure'
341 );
36099e8c 342=cut
343
344 my @want = (
345 qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./,
346 qr/\*+ ROLLBACK FAILED\!\!\! \*+/,
347 );
348
349 my @w;
350 local $SIG{__WARN__} = sub {
351 if (grep {$_[0] =~ $_} (@want)) {
352 push @w, $_[0];
353 }
354 else {
355 warn $_[0];
356 }
357 };
358 {
359 my $guard = $schema->txn_scope_guard;
360 $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
361
362 $schema->storage->disconnect; # this should freak out the guard rollback
363 }
364
365 is (@w, 2, 'Both expected warnings found');
c6e27318 366}
367
257a1d3b 368# make sure AutoCommit => 0 on external handles behaves correctly with scope_guard
cf31592c 369warnings_are {
257a1d3b 370 my $factory = DBICTest->init_schema (AutoCommit => 0);
371 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
372 my $dbh = $factory->storage->dbh;
373
374 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
375 my $schema = DBICTest::Schema->connect (sub { $dbh });
376
257a1d3b 377 lives_ok ( sub {
378 my $guard = $schema->txn_scope_guard;
379 $schema->resultset('CD')->delete;
380 $guard->commit;
381 }, 'No attempt to start a transaction with scope guard');
382
cf31592c 383 is ($schema->resultset('CD')->count, 0, 'Deletion successful in txn');
384
385 # this will commit the implicitly started txn
386 $dbh->commit;
387
388} [], 'No warnings on AutoCommit => 0 with txn_guard';
257a1d3b 389
390# make sure AutoCommit => 0 on external handles behaves correctly with txn_do
cf31592c 391warnings_are {
257a1d3b 392 my $factory = DBICTest->init_schema (AutoCommit => 0);
393 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
394 my $dbh = $factory->storage->dbh;
395
396 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
397 my $schema = DBICTest::Schema->connect (sub { $dbh });
398
399
400 lives_ok ( sub {
401 $schema->txn_do (sub { $schema->resultset ('CD')->delete });
402 }, 'No attempt to start a atransaction with txn_do');
403
404 is ($schema->resultset('CD')->count, 0, 'Deletion successful');
cf31592c 405
406 # this will commit the implicitly started txn
407 $dbh->commit;
408
409} [], 'No warnings on AutoCommit => 0 with txn_do';
257a1d3b 410
d7ded411 411done_testing;