Break out the txn_scope_guard tests, some cleanup
[dbsrgits/DBIx-Class.git] / t / storage / txn.t
1 use strict;
2 use warnings;
3
4 use Test::More;
5 use Test::Warn;
6 use Test::Exception;
7 use lib qw(t/lib);
8 use DBICTest;
9
10 my $code = sub {
11   my ($artist, @cd_titles) = @_;
12
13   $artist->create_related('cds', {
14     title => $_,
15     year => 2006,
16   }) foreach (@cd_titles);
17
18   return $artist->cds;
19 };
20
21 # Test checking of parameters
22 {
23   my $schema = DBICTest->init_schema;
24
25   throws_ok (sub {
26     (ref $schema)->txn_do(sub{});
27   }, qr/storage/, "can't call txn_do without storage");
28
29   throws_ok ( sub {
30     $schema->txn_do('');
31   }, qr/must be a CODE reference/, '$coderef parameter check ok');
32 }
33
34 # Test successful txn_do() - scalar/list context
35 for my $want (0,1) {
36   my $schema = DBICTest->init_schema;
37
38   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
39
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;
43
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   }
53
54   is($artist->cds({
55     title => "txn_do test CD $_",
56   })->first->year, 2006, "new CD $_ year correct") for (1..5);
57
58   is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
59 }
60
61 # Test txn_do() @_ aliasing support
62 {
63   my $schema = DBICTest->init_schema;
64
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
70 # Test nested successful txn_do()
71 {
72   my $schema = DBICTest->init_schema;
73
74   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
75
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
89   lives_ok (sub {
90     $schema->txn_do($nested_code, $schema, $artist, $code);
91   }, 'nested txn_do succeeded');
92
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');
97
98   is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
99 }
100
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   ) {
130     push @pids, fork();
131     die "Unable to fork: $!\n"
132       if ! defined $pids[-1];
133
134     if ($pids[-1]) {
135       next;
136     }
137
138     $action->($schema);
139     exit 0;
140   }
141
142   is ($schema->storage->transaction_depth, 0, 'Parent still outside txn');
143
144   for my $pid (@pids) {
145     waitpid ($pid, 0);
146     ok (! $?, "Child $pid exit ok");
147   }
148 }
149
150 # Test txn_do/scope_guard with forking: outer txn_do
151 {
152   my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
153
154   for my $pass (1..2) {
155
156     # do something trying to destabilize the depth count
157     for (1..2) {
158       eval {
159         my $guard = $schema->txn_scope_guard;
160         $schema->txn_do( sub { die } );
161       };
162       $schema->txn_do( sub {
163         ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)");
164       });
165     }
166
167     for my $pid ( $schema->txn_do ( sub { _forking_action ($schema) } ) ) {
168       waitpid ($pid, 0);
169       ok (! $?, "Child $pid exit ok (pass $pass)");
170       isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row');
171     }
172   }
173 }
174
175 # same test with outer guard
176 {
177   my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
178
179   for my $pass (1..2) {
180
181     # do something trying to destabilize the depth count
182     for (1..2) {
183       eval {
184         my $guard = $schema->txn_scope_guard;
185         $schema->txn_do( sub { die } );
186       };
187       $schema->txn_do( sub {
188         ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)");
189       });
190     }
191
192     my @pids;
193     my $guard = $schema->txn_scope_guard;
194     _forking_action ($schema);
195     $guard->commit;
196
197     for my $pid (@pids) {
198       waitpid ($pid, 0);
199       ok (! $?, "Child $pid exit ok (pass $pass)");
200       isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row');
201     }
202   }
203 }
204
205 sub _forking_action {
206   my $schema = shift;
207
208   my @pids;
209   while (@pids < 5) {
210
211     push @pids, fork();
212     die "Unable to fork: $!\n"
213       if ! defined $pids[-1];
214
215     if ($pids[-1]) {
216       next;
217     }
218
219     if (@pids % 2) {
220       $schema->txn_do (sub {
221         my $depth = $schema->storage->transaction_depth;
222         die "$$(txn_do)unexpected txn depth $depth!" if $depth != 1;
223         $schema->resultset ('Artist')->create ({ name => "forking action $$"});
224       });
225     }
226     else {
227       my $guard = $schema->txn_scope_guard;
228       my $depth = $schema->storage->transaction_depth;
229       die "$$(scope_guard) unexpected txn depth $depth!" if $depth != 1;
230       $schema->resultset ('Artist')->create ({ name => "forking action $$"});
231       $guard->commit;
232     }
233
234     exit 0;
235   }
236
237   return @pids;
238 }
239
240 my $fail_code = sub {
241   my ($artist) = @_;
242   $artist->create_related('cds', {
243     title => 'this should not exist',
244     year => 2005,
245   });
246   die "the sky is falling";
247 };
248
249 {
250   my $schema = DBICTest->init_schema;
251
252   # Test failed txn_do()
253   for my $pass (1,2) {
254
255     is( $schema->storage->{transaction_depth}, 0, "txn depth starts at 0 (pass $pass)");
256
257     my $artist = $schema->resultset('Artist')->find(3);
258
259     throws_ok (sub {
260       $schema->txn_do($fail_code, $artist);
261     }, qr/the sky is falling/, "failed txn_do threw an exception (pass $pass)");
262
263     my $cd = $artist->cds({
264       title => 'this should not exist',
265       year => 2005,
266     })->first;
267     ok(!defined($cd), qq{failed txn_do didn't change the cds table (pass $pass)});
268
269     is( $schema->storage->{transaction_depth}, 0, "txn depth has been reset (pass $pass)");
270   }
271
272
273   # Test failed txn_do() with failed rollback
274   {
275     is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
276
277     my $artist = $schema->resultset('Artist')->find(3);
278
279     # Force txn_rollback() to throw an exception
280     no warnings 'redefine';
281     no strict 'refs';
282
283     # die in rollback
284     local *{"DBIx::Class::Storage::DBI::SQLite::txn_rollback"} = sub{
285       my $storage = shift;
286       die 'FAILED';
287     };
288
289     throws_ok (
290       sub {
291         $schema->txn_do($fail_code, $artist);
292       },
293       qr/the sky is falling.+Rollback failed/s,
294       'txn_rollback threw a rollback exception (and included the original exception'
295     );
296
297     my $cd = $artist->cds({
298       title => 'this should not exist',
299       year => 2005,
300     })->first;
301     isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }.
302            q{changed the cds table});
303     $cd->delete; # Rollback failed
304     $cd = $artist->cds({
305       title => 'this should not exist',
306       year => 2005,
307     })->first;
308     ok(!defined($cd), q{deleted the failed txn's cd});
309     $schema->storage->_dbh->rollback;
310   }
311 }
312
313 # Test nested failed txn_do()
314 {
315   my $schema = DBICTest->init_schema();
316
317   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
318
319   my $nested_fail_code = sub {
320     my ($schema, $artist, $code1, $code2) = @_;
321
322     my @titles = map {'nested txn_do test CD ' . $_} (1..5);
323
324     $schema->txn_do($code1, $artist, @titles); # successful txn
325     $schema->txn_do($code2, $artist);          # failed txn
326   };
327
328   my $artist = $schema->resultset('Artist')->find(3);
329
330   throws_ok ( sub {
331     $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
332   }, qr/the sky is falling/, 'nested failed txn_do threw exception');
333
334   ok(!defined($artist->cds({
335     title => 'nested txn_do test CD '.$_,
336     year => 2006,
337   })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5);
338   my $cd = $artist->cds({
339     title => 'this should not exist',
340     year => 2005,
341   })->first;
342   ok(!defined($cd), q{failed txn_do didn't add failed txn's cd});
343 }
344
345 # Grab a new schema to test txn before connect
346 {
347   my $schema = DBICTest->init_schema(no_deploy => 1);
348   lives_ok (sub {
349     $schema->txn_begin();
350     $schema->txn_begin();
351   }, 'Pre-connection nested transactions.');
352
353   # although not connected DBI would still warn about rolling back at disconnect
354   $schema->txn_rollback;
355   $schema->txn_rollback;
356 }
357
358 # make sure AutoCommit => 0 on external handles behaves correctly with scope_guard
359 warnings_are {
360   my $factory = DBICTest->init_schema (AutoCommit => 0);
361   cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
362   my $dbh = $factory->storage->dbh;
363
364   ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
365   my $schema = DBICTest::Schema->connect (sub { $dbh });
366
367   lives_ok ( sub {
368     my $guard = $schema->txn_scope_guard;
369     $schema->resultset('CD')->delete;
370     $guard->commit;
371   }, 'No attempt to start a transaction with scope guard');
372
373   is ($schema->resultset('CD')->count, 0, 'Deletion successful in txn');
374
375   # this will commit the implicitly started txn
376   $dbh->commit;
377
378 } [], 'No warnings on AutoCommit => 0 with txn_guard';
379
380 # make sure AutoCommit => 0 on external handles behaves correctly with txn_do
381 warnings_are {
382   my $factory = DBICTest->init_schema (AutoCommit => 0);
383   cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
384   my $dbh = $factory->storage->dbh;
385
386   ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
387   my $schema = DBICTest::Schema->connect (sub { $dbh });
388
389
390   lives_ok ( sub {
391     $schema->txn_do (sub { $schema->resultset ('CD')->delete });
392   }, 'No attempt to start a atransaction with txn_do');
393
394   is ($schema->resultset('CD')->count, 0, 'Deletion successful');
395
396   # this will commit the implicitly started txn
397   $dbh->commit;
398
399 } [], 'No warnings on AutoCommit => 0 with txn_do';
400
401 done_testing;