Stop t/storage/error from failing on memory-leaking smokers
[dbsrgits/DBIx-Class.git] / t / storage / error.t
CommitLineData
a4b2f17b 1use strict;
a4b2f17b 2use warnings;
3
56166f36 4use Test::More;
5use Test::Warn;
6use Test::Exception;
a4b2f17b 7
8use lib qw(t/lib);
a4b2f17b 9use_ok( 'DBICTest' );
a4b2f17b 10use_ok( 'DBICTest::Schema' );
56166f36 11
e60dc79f 12my $schema = DBICTest->init_schema;
a4b2f17b 13
56166f36 14warnings_are ( sub {
b720efd1 15 throws_ok (
16 sub {
17 $schema->resultset('CD')->create({ title => 'vacation in antarctica' })
18 },
0007aedf 19 qr/DBI Exception.+constraint failed.+cd\.artist.+NULL/s
b720efd1 20 ); # as opposed to some other error
56166f36 21}, [], 'No warnings besides exception' );
a4b2f17b 22
b720efd1 23my $dbh = $schema->storage->dbh;
24
25throws_ok (
26 sub {
27 $dbh->do ('INSERT INTO nonexistent_table VALUES (1)')
28 },
0007aedf 29 qr/DBI Exception.+no such table.+nonexistent_table/s,
b720efd1 30 'DBI exceptions properly handled by dbic-installed callback'
31);
32
68fe9141 33# This usage is a bit unusual but it was actually seen in the wild
b720efd1 34# destruction of everything except the $dbh should use the proper
35# exception fallback:
36
cc1924ac 37SKIP: {
38 if (DBICTest::RunMode->peepeeness) {
39 skip "Your perl version $] appears to leak like a sieve - skipping garbage collected \$schema test", 1;
40 }
41
b720efd1 42 undef ($schema);
43 throws_ok (
44 sub {
45 $dbh->do ('INSERT INTO nonexistent_table VALUES (1)')
46 },
0007aedf 47 qr/DBI Exception.+unhandled by DBIC.+no such table.+nonexistent_table/s,
b720efd1 48 'callback works after $schema is gone'
49 );
50}
51
56166f36 52done_testing;