Commit | Line | Data |
c0329273 |
1 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
cb551b07 |
2 | use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_mysql'; |
3 | |
70350518 |
4 | use strict; |
68de9438 |
5 | use warnings; |
70350518 |
6 | |
7 | use Test::More; |
74de7c2c |
8 | use Test::Exception; |
722274d0 |
9 | use Test::Warn; |
da6a5860 |
10 | |
729656c5 |
11 | use B::Deparse; |
da6a5860 |
12 | use DBI::Const::GetInfoType; |
13 | use Scalar::Util qw/weaken/; |
14 | |
08a8d8f1 |
15 | use DBICTest::Util 'PEEPEENESS'; |
70350518 |
16 | use DBICTest; |
0567538f |
17 | |
18 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/}; |
19 | |
5f6bada6 |
20 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { quote_names => 1 }); |
0567538f |
21 | |
3ff5b740 |
22 | my $dbh = $schema->storage->dbh; |
0567538f |
23 | |
24 | $dbh->do("DROP TABLE IF EXISTS artist;"); |
25 | |
a0dd8679 |
26 | $dbh->do("CREATE TABLE artist (artistid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(100), rank INTEGER NOT NULL DEFAULT '13', charfield CHAR(10));"); |
0567538f |
27 | |
74de7c2c |
28 | $dbh->do("DROP TABLE IF EXISTS cd;"); |
29 | |
e0d56e26 |
30 | $dbh->do("CREATE TABLE cd (cdid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, artist INTEGER, title TEXT, year DATE, genreid INTEGER, single_track INTEGER);"); |
74de7c2c |
31 | |
32 | $dbh->do("DROP TABLE IF EXISTS producer;"); |
33 | |
34 | $dbh->do("CREATE TABLE producer (producerid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name TEXT);"); |
35 | |
36 | $dbh->do("DROP TABLE IF EXISTS cd_to_producer;"); |
37 | |
38 | $dbh->do("CREATE TABLE cd_to_producer (cd INTEGER,producer INTEGER);"); |
39 | |
bed3a173 |
40 | $dbh->do("DROP TABLE IF EXISTS owners;"); |
41 | |
42 | $dbh->do("CREATE TABLE owners (id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(100) NOT NULL);"); |
43 | |
44 | $dbh->do("DROP TABLE IF EXISTS books;"); |
45 | |
46 | $dbh->do("CREATE TABLE books (id INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, source VARCHAR(100) NOT NULL, owner integer NOT NULL, title varchar(100) NOT NULL, price integer);"); |
47 | |
0567538f |
48 | #'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', ''); |
49 | |
8273e845 |
50 | # make sure sqlt_type overrides work (::Storage::DBI::mysql does this) |
adbf0c89 |
51 | { |
52 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
53 | |
54 | ok (!$schema->storage->_dbh, 'definitely not connected'); |
55 | is ($schema->storage->sqlt_type, 'MySQL', 'sqlt_type correct pre-connection'); |
56 | } |
57 | |
3ff5b740 |
58 | # This is in Core now, but it's here just to test that it doesn't break |
59 | $schema->class('Artist')->load_components('PK::Auto'); |
0567538f |
60 | |
61 | # test primary key handling |
3ff5b740 |
62 | my $new = $schema->resultset('Artist')->create({ name => 'foo' }); |
0567538f |
63 | ok($new->artistid, "Auto-PK worked"); |
64 | |
65 | # test LIMIT support |
66 | for (1..6) { |
3ff5b740 |
67 | $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); |
0567538f |
68 | } |
3ff5b740 |
69 | my $it = $schema->resultset('Artist')->search( {}, |
0567538f |
70 | { rows => 3, |
71 | offset => 2, |
72 | order_by => 'artistid' } |
73 | ); |
fb4b58e8 |
74 | is( $it->count, 3, "LIMIT count ok" ); # ask for 3 rows out of 7 artists |
0567538f |
75 | is( $it->next->name, "Artist 2", "iterator->next ok" ); |
76 | $it->next; |
77 | $it->next; |
78 | is( $it->next, undef, "next past end of resultset ok" ); |
79 | |
e5372da4 |
80 | # Limit with select-lock |
81 | lives_ok { |
82 | $schema->txn_do (sub { |
83 | isa_ok ( |
84 | $schema->resultset('Artist')->find({artistid => 1}, {for => 'update', rows => 1}), |
85 | 'DBICTest::Schema::Artist', |
86 | ); |
87 | }); |
88 | } 'Limited FOR UPDATE select works'; |
89 | |
4e0a89e4 |
90 | # shared-lock |
91 | lives_ok { |
92 | $schema->txn_do (sub { |
93 | isa_ok ( |
94 | $schema->resultset('Artist')->find({artistid => 1}, {for => 'shared'}), |
95 | 'DBICTest::Schema::Artist', |
96 | ); |
97 | }); |
98 | } 'LOCK IN SHARE MODE select works'; |
99 | |
f45dc928 |
100 | my ($int_type_name, @undef_default) = DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE |
101 | ? ('integer') |
102 | : ( 'INT', default_value => undef ) |
103 | ; |
104 | |
a953d8d9 |
105 | my $test_type_info = { |
106 | 'artistid' => { |
f45dc928 |
107 | 'data_type' => $int_type_name, |
103e3e03 |
108 | 'is_nullable' => 0, |
fc22fbac |
109 | 'size' => 11, |
f45dc928 |
110 | @undef_default, |
a953d8d9 |
111 | }, |
112 | 'name' => { |
103e3e03 |
113 | 'data_type' => 'VARCHAR', |
a953d8d9 |
114 | 'is_nullable' => 1, |
a0dd8679 |
115 | 'size' => 100, |
f45dc928 |
116 | @undef_default, |
103e3e03 |
117 | }, |
39da2a2b |
118 | 'rank' => { |
f45dc928 |
119 | 'data_type' => $int_type_name, |
39da2a2b |
120 | 'is_nullable' => 0, |
121 | 'size' => 11, |
f45dc928 |
122 | DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE ? () : ( 'default_value' => '13' ), |
39da2a2b |
123 | }, |
103e3e03 |
124 | 'charfield' => { |
637219ab |
125 | 'data_type' => 'CHAR', |
103e3e03 |
126 | 'is_nullable' => 1, |
fc22fbac |
127 | 'size' => 10, |
f45dc928 |
128 | @undef_default, |
103e3e03 |
129 | }, |
a953d8d9 |
130 | }; |
131 | |
bed3a173 |
132 | $schema->populate ('Owners', [ |
133 | [qw/id name /], |
134 | [qw/1 wiggle/], |
135 | [qw/2 woggle/], |
136 | [qw/3 boggle/], |
137 | ]); |
138 | |
139 | $schema->populate ('BooksInLibrary', [ |
140 | [qw/source owner title /], |
13a2f031 |
141 | [qw/Library 1 secrets1/], |
142 | [qw/Eatery 1 secrets2/], |
143 | [qw/Library 2 secrets3/], |
bed3a173 |
144 | ]); |
145 | |
13a2f031 |
146 | # |
8273e845 |
147 | # try a distinct + prefetch on tables with identically named columns |
13a2f031 |
148 | # (mysql doesn't seem to like subqueries with equally named columns) |
149 | # |
bed3a173 |
150 | |
d758ec36 |
151 | { |
13a2f031 |
152 | # try a ->has_many direction (due to a 'multi' accessor the select/group_by group is collapsed) |
153 | my $owners = $schema->resultset ('Owners')->search ( |
154 | { 'books.id' => { '!=', undef }}, |
155 | { prefetch => 'books', distinct => 1 } |
156 | ); |
157 | my $owners2 = $schema->resultset ('Owners')->search ({ id => { -in => $owners->get_column ('me.id')->as_query }}); |
158 | for ($owners, $owners2) { |
b5963465 |
159 | is ($_->all, 2, 'Prefetched grouped search returns correct number of rows'); |
160 | is ($_->count, 2, 'Prefetched grouped search returns correct count'); |
13a2f031 |
161 | } |
162 | |
d758ec36 |
163 | # try a ->belongs_to direction (no select collapse) |
b5963465 |
164 | my $books = $schema->resultset ('BooksInLibrary')->search ( |
165 | { 'owner.name' => 'wiggle' }, |
166 | { prefetch => 'owner', distinct => 1 } |
167 | ); |
168 | my $books2 = $schema->resultset ('BooksInLibrary')->search ({ id => { -in => $books->get_column ('me.id')->as_query }}); |
169 | for ($books, $books2) { |
170 | is ($_->all, 1, 'Prefetched grouped search returns correct number of rows'); |
171 | is ($_->count, 1, 'Prefetched grouped search returns correct count'); |
13a2f031 |
172 | } |
173 | } |
bed3a173 |
174 | |
5db49b9a |
175 | SKIP: { |
af1f4f84 |
176 | my $norm_version = $schema->storage->_server_info->{normalized_dbms_version} |
177 | or skip "Cannot determine MySQL server version", 1; |
a953d8d9 |
178 | |
af1f4f84 |
179 | if ($norm_version < 5.000003_01) { |
5db49b9a |
180 | $test_type_info->{charfield}->{data_type} = 'VARCHAR'; |
181 | } |
a953d8d9 |
182 | |
f45dc928 |
183 | if (DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE) { |
184 | $_->{data_type} = lc $_->{data_type} for values %$test_type_info; |
185 | } |
186 | |
3ff5b740 |
187 | my $type_info = $schema->storage->columns_info_for('artist'); |
5db49b9a |
188 | is_deeply($type_info, $test_type_info, 'columns_info_for - column data types'); |
189 | } |
a953d8d9 |
190 | |
6a999241 |
191 | my $cd = $schema->resultset ('CD')->create ({}); |
192 | my $producer = $schema->resultset ('Producer')->create ({}); |
193 | lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die'; |
194 | |
aa82ce29 |
195 | { |
196 | my $artist = $schema->resultset('Artist')->next; |
197 | my $cd = $schema->resultset('CD')->next; |
198 | $cd->set_from_related ('artist', $artist); |
199 | $cd->update; |
200 | |
201 | my $rs = $schema->resultset('CD')->search ({}, { prefetch => 'artist' }); |
202 | |
203 | lives_ok sub { |
204 | my $cd = $rs->next; |
205 | is ($cd->artist->name, $artist->name, 'Prefetched artist'); |
206 | }, 'join does not throw (mysql 3 test)'; |
aa82ce29 |
207 | } |
6a999241 |
208 | |
55cfbb70 |
209 | ## Can we properly deal with the null search problem? |
a7e65bb5 |
210 | ## |
211 | ## Only way is to do a SET SQL_AUTO_IS_NULL = 0; on connect |
212 | ## But I'm not sure if we should do this or not (Ash, 2008/06/03) |
0fde80d9 |
213 | # |
214 | # There is now a built-in function to do this, test that everything works |
215 | # with it (ribasushi, 2009/07/03) |
55cfbb70 |
216 | |
217 | NULLINSEARCH: { |
97a0a148 |
218 | my $ansi_schema = DBICTest::Schema->connect ($dsn, $user, $pass, { on_connect_call => 'set_strict_mode' }); |
8de9298c |
219 | |
220 | $ansi_schema->resultset('Artist')->create ({ name => 'last created artist' }); |
6a999241 |
221 | |
222 | ok my $artist1_rs = $ansi_schema->resultset('Artist')->search({artistid=>6666}) |
223 | => 'Created an artist resultset of 6666'; |
224 | |
55cfbb70 |
225 | is $artist1_rs->count, 0 |
6a999241 |
226 | => 'Got no returned rows'; |
374dd926 |
227 | |
6a999241 |
228 | ok my $artist2_rs = $ansi_schema->resultset('Artist')->search({artistid=>undef}) |
229 | => 'Created an artist resultset of undef'; |
74de7c2c |
230 | |
6a999241 |
231 | is $artist2_rs->count, 0 |
232 | => 'got no rows'; |
74de7c2c |
233 | |
6a999241 |
234 | my $artist = $artist2_rs->single; |
55cfbb70 |
235 | |
5083f7de |
236 | is $artist => undef, |
6a999241 |
237 | => 'Nothing Found!'; |
74de7c2c |
238 | } |
aa82ce29 |
239 | |
0ce4ab92 |
240 | # check for proper grouped counts |
241 | { |
9f775126 |
242 | my $ansi_schema = DBICTest::Schema->connect ($dsn, $user, $pass, { |
243 | on_connect_call => 'set_strict_mode', |
244 | quote_char => '`', |
9f775126 |
245 | }); |
0ce4ab92 |
246 | my $rs = $ansi_schema->resultset('CD'); |
247 | |
248 | my $years; |
249 | $years->{$_->year|| scalar keys %$years}++ for $rs->all; # NULL != NULL, thus the keys eval |
250 | |
251 | lives_ok ( sub { |
252 | is ( |
253 | $rs->search ({}, { group_by => 'year'})->count, |
254 | scalar keys %$years, |
255 | 'grouped count correct', |
256 | ); |
257 | }, 'Grouped count does not throw'); |
9f775126 |
258 | |
259 | lives_ok( sub { |
260 | $ansi_schema->resultset('Owners')->search({}, { |
261 | join => 'books', group_by => [ 'me.id', 'books.id' ] |
262 | })->count(); |
263 | }, 'count on grouped columns with the same name does not throw'); |
0ce4ab92 |
264 | } |
265 | |
45150bc4 |
266 | # a more contrived^Wcomplicated self-referential double-subquery test |
267 | { |
268 | my $rs = $schema->resultset('Artist')->search({ name => { -like => 'baby_%' } }); |
269 | |
270 | $rs->populate([map { [$_] } ('name', map { "baby_$_" } (1..10) ) ]); |
271 | |
272 | my ($count_sql, @count_bind) = @${$rs->count_rs->as_query}; |
273 | |
274 | my $complex_rs = $schema->resultset('Artist')->search( |
275 | { artistid => { |
276 | -in => $rs->get_column('artistid') |
277 | ->as_query |
278 | } }, |
279 | ); |
280 | |
281 | $complex_rs->update({ name => \[ "CONCAT( `name`, '_bell_out_of_', $count_sql )", @count_bind ] }); |
282 | |
283 | for (1..10) { |
284 | is ( |
285 | $schema->resultset('Artist')->search({ name => "baby_${_}_bell_out_of_10" })->count, |
286 | 1, |
287 | "Correctly updated babybell $_", |
288 | ); |
289 | } |
290 | |
f4fdfd69 |
291 | is ($rs->count, 10, '10 artists present'); |
45150bc4 |
292 | |
49eeb48d |
293 | $schema->is_executed_querycount( sub { |
294 | $complex_rs->delete; |
295 | }, 1, 'One delete query fired' ); |
f4fdfd69 |
296 | is ($rs->count, 0, '10 Artists correctly deleted'); |
297 | |
298 | $rs->create({ |
299 | name => 'baby_with_cd', |
300 | cds => [ { title => 'babeeeeee', year => 2013 } ], |
301 | }); |
302 | is ($rs->count, 1, 'Artist with cd created'); |
303 | |
f4fdfd69 |
304 | |
49eeb48d |
305 | $schema->is_executed_querycount( sub { |
306 | $schema->resultset('CD')->search_related('artist', |
307 | { 'artist.name' => { -like => 'baby_with_%' } } |
308 | )->delete; |
309 | }, 1, 'And one more delete query fired'); |
310 | is ($rs->count, 0, 'Artist with cd deleted'); |
45150bc4 |
311 | } |
312 | |
e0d56e26 |
313 | ZEROINSEARCH: { |
314 | my $cds_per_year = { |
315 | 2001 => 2, |
316 | 2002 => 1, |
317 | 2005 => 3, |
318 | }; |
319 | |
320 | my $rs = $schema->resultset ('CD'); |
321 | $rs->delete; |
322 | for my $y (keys %$cds_per_year) { |
323 | for my $c (1 .. $cds_per_year->{$y} ) { |
324 | $rs->create ({ title => "CD $y-$c", artist => 1, year => "$y-01-01" }); |
325 | } |
326 | } |
327 | |
328 | is ($rs->count, 6, 'CDs created successfully'); |
329 | |
330 | $rs = $rs->search ({}, { |
ca458871 |
331 | select => [ \ 'YEAR(year)' ], as => ['y'], distinct => 1, |
e0d56e26 |
332 | }); |
333 | |
722274d0 |
334 | my $y_rs = $rs->get_column ('y'); |
335 | |
336 | warnings_exist { is_deeply ( |
337 | [ sort ($y_rs->all) ], |
e0d56e26 |
338 | [ sort keys %$cds_per_year ], |
339 | 'Years group successfully', |
722274d0 |
340 | ) } qr/ |
341 | \QUse of distinct => 1 while selecting anything other than a column \E |
342 | \Qdeclared on the primary ResultSource is deprecated\E |
343 | /x, 'deprecation warning'; |
344 | |
e0d56e26 |
345 | |
346 | $rs->create ({ artist => 1, year => '0-1-1', title => 'Jesus Rap' }); |
347 | |
348 | is_deeply ( |
722274d0 |
349 | [ sort $y_rs->all ], |
e0d56e26 |
350 | [ 0, sort keys %$cds_per_year ], |
351 | 'Zero-year groups successfully', |
352 | ); |
353 | |
8273e845 |
354 | # convoluted search taken verbatim from list |
e0d56e26 |
355 | my $restrict_rs = $rs->search({ -and => [ |
356 | year => { '!=', 0 }, |
357 | year => { '!=', undef } |
358 | ]}); |
359 | |
722274d0 |
360 | warnings_exist { is_deeply ( |
1b658919 |
361 | [ sort $restrict_rs->get_column('y')->all ], |
362 | [ sort $y_rs->all ], |
e0d56e26 |
363 | 'Zero year was correctly excluded from resultset', |
722274d0 |
364 | ) } qr/ |
365 | \QUse of distinct => 1 while selecting anything other than a column \E |
366 | \Qdeclared on the primary ResultSource is deprecated\E |
367 | /x, 'deprecation warning'; |
e0d56e26 |
368 | } |
10176e1f |
369 | |
f98120e4 |
370 | # make sure find hooks determine driver |
371 | { |
372 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
373 | $schema->resultset("Artist")->find(4); |
374 | isa_ok($schema->storage->sql_maker, 'DBIx::Class::SQLMaker::MySQL'); |
375 | } |
376 | |
377 | # make sure the mysql_auto_reconnect buggery is avoided |
378 | { |
379 | local $ENV{MOD_PERL} = 'boogiewoogie'; |
380 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
381 | ok (! $schema->storage->_get_dbh->{mysql_auto_reconnect}, 'mysql_auto_reconnect unset regardless of ENV' ); |
382 | |
da6a5860 |
383 | # Make sure hardcore forking action still works even if mysql_auto_reconnect |
384 | # is true (test inspired by ether) |
385 | |
386 | my $schema_autorecon = DBICTest::Schema->connect($dsn, $user, $pass, { mysql_auto_reconnect => 1 }); |
387 | my $orig_dbh = $schema_autorecon->storage->_get_dbh; |
388 | weaken $orig_dbh; |
389 | |
390 | ok ($orig_dbh, 'Got weak $dbh ref'); |
391 | ok ($orig_dbh->{mysql_auto_reconnect}, 'mysql_auto_reconnect is properly set if explicitly requested' ); |
392 | |
393 | my $rs = $schema_autorecon->resultset('Artist'); |
394 | |
7be5717e |
395 | my ($parent_in, $child_out); |
396 | pipe( $parent_in, $child_out ) or die "Pipe open failed: $!"; |
da6a5860 |
397 | my $pid = fork(); |
398 | if (! defined $pid ) { |
399 | die "fork() failed: $!" |
400 | } |
401 | elsif ($pid) { |
7be5717e |
402 | close $child_out; |
403 | |
da6a5860 |
404 | # sanity check |
405 | $schema_autorecon->storage->dbh_do(sub { |
406 | is ($_[1], $orig_dbh, 'Storage holds correct $dbh in parent'); |
407 | }); |
408 | |
409 | # kill our $dbh |
410 | $schema_autorecon->storage->_dbh(undef); |
e0b2dc74 |
411 | |
4ca1fd6f |
412 | { |
e0b2dc74 |
413 | local $TODO = "Perl $] is known to leak like a sieve" |
08a8d8f1 |
414 | if PEEPEENESS; |
e0b2dc74 |
415 | |
416 | ok (! defined $orig_dbh, 'Parent $dbh handle is gone'); |
417 | } |
da6a5860 |
418 | } |
419 | else { |
7be5717e |
420 | close $parent_in; |
da6a5860 |
421 | |
422 | #simulate a subtest to not confuse the parent TAP emission |
7be5717e |
423 | my $tb = Test::More->builder; |
424 | $tb->reset; |
425 | for (qw/output failure_output todo_output/) { |
426 | close $tb->$_; |
427 | open ($tb->$_, '>&', $child_out); |
428 | } |
429 | |
430 | # wait for parent to kill its $dbh |
431 | sleep 1; |
da6a5860 |
432 | |
da6a5860 |
433 | # try to do something dbic-esque |
434 | $rs->create({ name => "Hardcore Forker $$" }); |
435 | |
4ca1fd6f |
436 | { |
e0b2dc74 |
437 | local $TODO = "Perl $] is known to leak like a sieve" |
08a8d8f1 |
438 | if PEEPEENESS; |
e0b2dc74 |
439 | |
440 | ok (! defined $orig_dbh, 'DBIC operation triggered reconnect - old $dbh is gone'); |
441 | } |
da6a5860 |
442 | |
7be5717e |
443 | done_testing; |
da6a5860 |
444 | exit 0; |
445 | } |
446 | |
7be5717e |
447 | while (my $ln = <$parent_in>) { |
448 | print " $ln"; |
449 | } |
da6a5860 |
450 | wait; |
451 | ok(!$?, 'Child subtests passed'); |
452 | |
453 | ok ($rs->find({ name => "Hardcore Forker $pid" }), 'Expected row created'); |
f98120e4 |
454 | } |
10176e1f |
455 | |
729656c5 |
456 | # Ensure disappearing RDBMS does not leave the storage in an inconsistent state |
457 | # Unlike the test in storage/reconnect.t we test live RDBMS-side disconnection |
25c1ed5f |
458 | SKIP: |
729656c5 |
459 | for my $cref ( |
460 | sub { |
461 | my $schema = shift; |
462 | |
463 | my $g = $schema->txn_scope_guard; |
464 | |
465 | is( $schema->storage->transaction_depth, 1, "Expected txn depth" ); |
466 | |
467 | $schema->storage->_dbh->do("SELECT SLEEP(2)"); |
468 | }, |
469 | sub { |
470 | my $schema = shift; |
471 | $schema->txn_do(sub { |
472 | is( $schema->storage->transaction_depth, 1, "Expected txn depth" ); |
473 | $schema->storage->_dbh->do("SELECT SLEEP(2)") |
474 | } ); |
475 | }, |
476 | sub { |
477 | my $schema = shift; |
478 | |
479 | my $g = $schema->txn_scope_guard; |
480 | |
481 | $schema->txn_do(sub { |
482 | is( $schema->storage->transaction_depth, 2, "Expected txn depth" ); |
483 | $schema->storage->_dbh->do("SELECT SLEEP(2)") |
484 | } ); |
485 | }, |
486 | ) { |
25c1ed5f |
487 | # version needed for the "read_timeout" feature |
488 | DBIx::Class::Optional::Dependencies->skip_without( 'DBD::mysql>=4.023' ); |
729656c5 |
489 | |
490 | note( "Testing with " . B::Deparse->new->coderef2text($cref) ); |
491 | |
492 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { |
493 | mysql_read_timeout => 1, |
494 | }); |
495 | |
496 | ok( !$schema->storage->connected, 'Not connected' ); |
497 | |
498 | is( $schema->storage->transaction_depth, undef, "Start with unknown txn depth" ); |
499 | |
500 | throws_ok { |
501 | $cref->($schema) |
502 | } qr/Rollback failed/; |
503 | |
504 | ok( !$schema->storage->connected, 'Not connected as a result of failed rollback' ); |
505 | |
506 | is( $schema->storage->transaction_depth, undef, "Depth expectedly unknown after failed rollbacks" ); |
507 | |
508 | ok( $schema->resultset('Artist')->count, 'query works after the fact' ); |
509 | } |
510 | |
aa82ce29 |
511 | done_testing; |