Commit | Line | Data |
70350518 |
1 | use strict; |
d7ded411 |
2 | use warnings; |
70350518 |
3 | |
4 | use Test::More; |
d7ded411 |
5 | use Test::Warn; |
3b7f3eac |
6 | use Test::Exception; |
70350518 |
7 | use lib qw(t/lib); |
8 | use DBICTest; |
9 | |
597cf92a |
10 | plan skip_all => 'Disabled on windows, pending resolution of DBD::SQLite SIGSEGVs' |
11 | if $^O eq 'MSWin32'; |
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 | |
32 | throws_ok ( sub { |
171dadd7 |
33 | $schema->txn_do(''); |
dd7d4b43 |
34 | }, qr/must be a CODE reference/, '$coderef parameter check ok'); |
171dadd7 |
35 | } |
36 | |
471a5fdd |
37 | # Test successful txn_do() - scalar/list context |
38 | for my $want (0,1) { |
39 | my $schema = DBICTest->init_schema; |
40 | |
57c18b65 |
41 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
42 | |
a62cf8d4 |
43 | my @titles = map {'txn_do test CD ' . $_} (1..5); |
44 | my $artist = $schema->resultset('Artist')->find(1); |
45 | my $count_before = $artist->cds->count; |
a62cf8d4 |
46 | |
471a5fdd |
47 | my @res; |
48 | if ($want) { |
49 | @res = $schema->txn_do($code, $artist, @titles); |
50 | is(scalar @res, $count_before+5, 'successful txn added 5 cds'); |
51 | } |
52 | else { |
53 | $res[0] = $schema->txn_do($code, $artist, @titles); |
54 | is($res[0], $count_before+5, 'successful txn added 5 cds'); |
55 | } |
57c18b65 |
56 | |
a62cf8d4 |
57 | is($artist->cds({ |
58 | title => "txn_do test CD $_", |
471a5fdd |
59 | })->first->year, 2006, "new CD $_ year correct") for (1..5); |
57c18b65 |
60 | |
61 | is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); |
a62cf8d4 |
62 | } |
63 | |
38ed54cd |
64 | # Test txn_do() @_ aliasing support |
65 | { |
471a5fdd |
66 | my $schema = DBICTest->init_schema; |
67 | |
38ed54cd |
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 | { |
471a5fdd |
75 | my $schema = DBICTest->init_schema; |
76 | |
57c18b65 |
77 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
78 | |
a62cf8d4 |
79 | my $nested_code = sub { |
80 | my ($schema, $artist, $code) = @_; |
81 | |
82 | my @titles1 = map {'nested txn_do test CD ' . $_} (1..5); |
83 | my @titles2 = map {'nested txn_do test CD ' . $_} (6..10); |
84 | |
85 | $schema->txn_do($code, $artist, @titles1); |
86 | $schema->txn_do($code, $artist, @titles2); |
87 | }; |
88 | |
89 | my $artist = $schema->resultset('Artist')->find(2); |
90 | my $count_before = $artist->cds->count; |
91 | |
dd7d4b43 |
92 | lives_ok (sub { |
a62cf8d4 |
93 | $schema->txn_do($nested_code, $schema, $artist, $code); |
dd7d4b43 |
94 | }, 'nested txn_do succeeded'); |
a62cf8d4 |
95 | |
a62cf8d4 |
96 | is($artist->cds({ |
97 | title => 'nested txn_do test CD '.$_, |
98 | })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10); |
99 | is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs'); |
57c18b65 |
100 | |
101 | is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); |
a62cf8d4 |
102 | } |
103 | |
7d216b10 |
104 | # test nested txn_begin on fresh connection |
105 | { |
106 | my $schema = DBICTest->init_schema(sqlite_use_file => 1, no_deploy => 1); |
107 | $schema->storage->ensure_connected; |
108 | |
109 | is ($schema->storage->transaction_depth, 0, 'Start outside txn'); |
110 | |
111 | my @pids; |
112 | for my $action ( |
113 | sub { |
114 | my $s = shift; |
115 | die "$$ starts in txn!" if $s->storage->transaction_depth != 0; |
116 | $s->txn_do ( sub { |
117 | die "$$ not in txn!" if $s->storage->transaction_depth == 0; |
118 | $s->storage->dbh->do('SELECT 1') } |
119 | ); |
120 | die "$$ did not finish txn!" if $s->storage->transaction_depth != 0; |
121 | }, |
122 | sub { |
123 | $_[0]->txn_begin; |
124 | $_[0]->storage->dbh->do('SELECT 1'); |
125 | $_[0]->txn_commit |
126 | }, |
127 | sub { |
128 | my $guard = $_[0]->txn_scope_guard; |
129 | $_[0]->storage->dbh->do('SELECT 1'); |
130 | $guard->commit |
131 | }, |
132 | ) { |
133 | push @pids, fork(); |
134 | die "Unable to fork: $!\n" |
135 | if ! defined $pids[-1]; |
136 | |
137 | if ($pids[-1]) { |
138 | next; |
139 | } |
140 | |
141 | $action->($schema); |
142 | exit 0; |
143 | } |
144 | |
145 | is ($schema->storage->transaction_depth, 0, 'Parent still outside txn'); |
146 | |
147 | for my $pid (@pids) { |
148 | waitpid ($pid, 0); |
149 | ok (! $?, "Child $pid exit ok"); |
150 | } |
151 | } |
152 | |
153 | # Test txn_do/scope_guard with forking: outer txn_do |
154 | { |
155 | my $schema = DBICTest->init_schema( sqlite_use_file => 1 ); |
156 | |
157 | for my $pass (1..2) { |
158 | |
159 | # do something trying to destabilize the depth count |
160 | for (1..2) { |
161 | eval { |
162 | my $guard = $schema->txn_scope_guard; |
163 | $schema->txn_do( sub { die } ); |
164 | }; |
165 | $schema->txn_do( sub { |
166 | ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)"); |
167 | }); |
168 | } |
169 | |
170 | for my $pid ( $schema->txn_do ( sub { _forking_action ($schema) } ) ) { |
171 | waitpid ($pid, 0); |
172 | ok (! $?, "Child $pid exit ok (pass $pass)"); |
173 | isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row'); |
174 | } |
175 | } |
176 | } |
177 | |
178 | # same test with outer guard |
179 | { |
180 | my $schema = DBICTest->init_schema( sqlite_use_file => 1 ); |
181 | |
182 | for my $pass (1..2) { |
183 | |
184 | # do something trying to destabilize the depth count |
185 | for (1..2) { |
186 | eval { |
187 | my $guard = $schema->txn_scope_guard; |
188 | $schema->txn_do( sub { die } ); |
189 | }; |
190 | $schema->txn_do( sub { |
191 | ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)"); |
192 | }); |
193 | } |
194 | |
195 | my @pids; |
196 | my $guard = $schema->txn_scope_guard; |
197 | _forking_action ($schema); |
198 | $guard->commit; |
199 | |
200 | for my $pid (@pids) { |
201 | waitpid ($pid, 0); |
202 | ok (! $?, "Child $pid exit ok (pass $pass)"); |
203 | isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row'); |
204 | } |
205 | } |
206 | } |
207 | |
208 | sub _forking_action { |
209 | my $schema = shift; |
210 | |
211 | my @pids; |
212 | while (@pids < 5) { |
213 | |
214 | push @pids, fork(); |
215 | die "Unable to fork: $!\n" |
216 | if ! defined $pids[-1]; |
217 | |
218 | if ($pids[-1]) { |
219 | next; |
220 | } |
221 | |
222 | if (@pids % 2) { |
223 | $schema->txn_do (sub { |
224 | my $depth = $schema->storage->transaction_depth; |
225 | die "$$(txn_do)unexpected txn depth $depth!" if $depth != 1; |
226 | $schema->resultset ('Artist')->create ({ name => "forking action $$"}); |
227 | }); |
228 | } |
229 | else { |
230 | my $guard = $schema->txn_scope_guard; |
231 | my $depth = $schema->storage->transaction_depth; |
232 | die "$$(scope_guard) unexpected txn depth $depth!" if $depth != 1; |
233 | $schema->resultset ('Artist')->create ({ name => "forking action $$"}); |
234 | $guard->commit; |
235 | } |
236 | |
237 | exit 0; |
238 | } |
239 | |
240 | return @pids; |
241 | } |
242 | |
a62cf8d4 |
243 | my $fail_code = sub { |
244 | my ($artist) = @_; |
245 | $artist->create_related('cds', { |
246 | title => 'this should not exist', |
247 | year => 2005, |
248 | }); |
249 | die "the sky is falling"; |
250 | }; |
251 | |
a62cf8d4 |
252 | { |
471a5fdd |
253 | my $schema = DBICTest->init_schema; |
57c18b65 |
254 | |
471a5fdd |
255 | # Test failed txn_do() |
256 | for my $pass (1,2) { |
57c18b65 |
257 | |
471a5fdd |
258 | is( $schema->storage->{transaction_depth}, 0, "txn depth starts at 0 (pass $pass)"); |
a62cf8d4 |
259 | |
471a5fdd |
260 | my $artist = $schema->resultset('Artist')->find(3); |
a62cf8d4 |
261 | |
471a5fdd |
262 | throws_ok (sub { |
263 | $schema->txn_do($fail_code, $artist); |
264 | }, qr/the sky is falling/, "failed txn_do threw an exception (pass $pass)"); |
57c18b65 |
265 | |
471a5fdd |
266 | my $cd = $artist->cds({ |
267 | title => 'this should not exist', |
268 | year => 2005, |
269 | })->first; |
270 | ok(!defined($cd), qq{failed txn_do didn't change the cds table (pass $pass)}); |
a62cf8d4 |
271 | |
471a5fdd |
272 | is( $schema->storage->{transaction_depth}, 0, "txn depth has been reset (pass $pass)"); |
273 | } |
57c18b65 |
274 | |
a62cf8d4 |
275 | |
471a5fdd |
276 | # Test failed txn_do() with failed rollback |
277 | { |
278 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
57c18b65 |
279 | |
471a5fdd |
280 | my $artist = $schema->resultset('Artist')->find(3); |
a62cf8d4 |
281 | |
471a5fdd |
282 | # Force txn_rollback() to throw an exception |
283 | no warnings 'redefine'; |
284 | no strict 'refs'; |
a62cf8d4 |
285 | |
471a5fdd |
286 | # die in rollback |
287 | local *{"DBIx::Class::Storage::DBI::SQLite::txn_rollback"} = sub{ |
288 | my $storage = shift; |
289 | die 'FAILED'; |
290 | }; |
d9c17594 |
291 | |
471a5fdd |
292 | throws_ok ( |
293 | sub { |
294 | $schema->txn_do($fail_code, $artist); |
295 | }, |
296 | qr/the sky is falling.+Rollback failed/s, |
297 | 'txn_rollback threw a rollback exception (and included the original exception' |
298 | ); |
299 | |
300 | my $cd = $artist->cds({ |
301 | title => 'this should not exist', |
302 | year => 2005, |
303 | })->first; |
304 | isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }. |
305 | q{changed the cds table}); |
306 | $cd->delete; # Rollback failed |
307 | $cd = $artist->cds({ |
308 | title => 'this should not exist', |
309 | year => 2005, |
310 | })->first; |
311 | ok(!defined($cd), q{deleted the failed txn's cd}); |
312 | $schema->storage->_dbh->rollback; |
313 | } |
a62cf8d4 |
314 | } |
315 | |
316 | # Test nested failed txn_do() |
317 | { |
d9c17594 |
318 | my $schema = DBICTest->init_schema(); |
319 | |
57c18b65 |
320 | is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); |
321 | |
a62cf8d4 |
322 | my $nested_fail_code = sub { |
323 | my ($schema, $artist, $code1, $code2) = @_; |
324 | |
325 | my @titles = map {'nested txn_do test CD ' . $_} (1..5); |
326 | |
327 | $schema->txn_do($code1, $artist, @titles); # successful txn |
328 | $schema->txn_do($code2, $artist); # failed txn |
329 | }; |
330 | |
331 | my $artist = $schema->resultset('Artist')->find(3); |
332 | |
dd7d4b43 |
333 | throws_ok ( sub { |
a62cf8d4 |
334 | $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code); |
dd7d4b43 |
335 | }, qr/the sky is falling/, 'nested failed txn_do threw exception'); |
a62cf8d4 |
336 | |
a62cf8d4 |
337 | ok(!defined($artist->cds({ |
338 | title => 'nested txn_do test CD '.$_, |
339 | year => 2006, |
340 | })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5); |
341 | my $cd = $artist->cds({ |
342 | title => 'this should not exist', |
343 | year => 2005, |
344 | })->first; |
345 | ok(!defined($cd), q{failed txn_do didn't add failed txn's cd}); |
346 | } |
a62cf8d4 |
347 | |
291bf95f |
348 | # Grab a new schema to test txn before connect |
349 | { |
d9c17594 |
350 | my $schema = DBICTest->init_schema(no_deploy => 1); |
351 | lives_ok (sub { |
352 | $schema->txn_begin(); |
353 | $schema->txn_begin(); |
354 | }, 'Pre-connection nested transactions.'); |
355 | |
356 | # although not connected DBI would still warn about rolling back at disconnect |
357 | $schema->txn_rollback; |
358 | $schema->txn_rollback; |
291bf95f |
359 | } |
3b7f3eac |
360 | |
257a1d3b |
361 | # make sure AutoCommit => 0 on external handles behaves correctly with scope_guard |
cf31592c |
362 | warnings_are { |
257a1d3b |
363 | my $factory = DBICTest->init_schema (AutoCommit => 0); |
364 | cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete'); |
365 | my $dbh = $factory->storage->dbh; |
366 | |
367 | ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh'); |
368 | my $schema = DBICTest::Schema->connect (sub { $dbh }); |
369 | |
257a1d3b |
370 | lives_ok ( sub { |
371 | my $guard = $schema->txn_scope_guard; |
372 | $schema->resultset('CD')->delete; |
373 | $guard->commit; |
374 | }, 'No attempt to start a transaction with scope guard'); |
375 | |
cf31592c |
376 | is ($schema->resultset('CD')->count, 0, 'Deletion successful in txn'); |
377 | |
378 | # this will commit the implicitly started txn |
379 | $dbh->commit; |
380 | |
381 | } [], 'No warnings on AutoCommit => 0 with txn_guard'; |
257a1d3b |
382 | |
383 | # make sure AutoCommit => 0 on external handles behaves correctly with txn_do |
cf31592c |
384 | warnings_are { |
257a1d3b |
385 | my $factory = DBICTest->init_schema (AutoCommit => 0); |
386 | cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete'); |
387 | my $dbh = $factory->storage->dbh; |
388 | |
389 | ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh'); |
390 | my $schema = DBICTest::Schema->connect (sub { $dbh }); |
391 | |
392 | |
393 | lives_ok ( sub { |
394 | $schema->txn_do (sub { $schema->resultset ('CD')->delete }); |
395 | }, 'No attempt to start a atransaction with txn_do'); |
396 | |
397 | is ($schema->resultset('CD')->count, 0, 'Deletion successful'); |
cf31592c |
398 | |
399 | # this will commit the implicitly started txn |
400 | $dbh->commit; |
401 | |
402 | } [], 'No warnings on AutoCommit => 0 with txn_do'; |
257a1d3b |
403 | |
d7ded411 |
404 | done_testing; |