Commit | Line | Data |
70350518 |
1 | use strict; |
d7ded411 |
2 | use warnings; |
70350518 |
3 | |
8bab2062 |
4 | BEGIN { |
5 | require threads if $^O eq 'MSWin32'; # preload due to fork errors |
6 | } |
7 | |
70350518 |
8 | use Test::More; |
d7ded411 |
9 | use Test::Warn; |
3b7f3eac |
10 | use Test::Exception; |
70350518 |
11 | use lib qw(t/lib); |
12 | use DBICTest; |
13 | |
a62cf8d4 |
14 | my $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 |
39 | for 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 |
201 | sub _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 |
251 | my $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 |
370 | warnings_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 |
393 | warnings_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 |
413 | done_testing; |