1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
use strict;
use warnings;
use Test::More;
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
use DBICTest::Schema;
# make sure nothing eats the exceptions (an unchecked eval in Storage::DESTROY used to be a problem)
{
package Dying::Storage;
use warnings;
use strict;
use base 'DBIx::Class::Storage::DBI';
__PACKAGE__->sql_limit_dialect ('LimitOffset');
sub _populate_dbh {
my $self = shift;
my $death = $self->_dbi_connect_info->[3]{die};
die "storage test died: $death" if $death eq 'before_populate';
my $ret = $self->next::method (@_);
die "storage test died: $death" if $death eq 'after_populate';
return $ret;
}
}
for (qw/before_populate after_populate/) {
throws_ok (sub {
my $schema = DBICTest::Schema->clone;
$schema->storage_type ('Dying::Storage');
$schema->connection (DBICTest->_database, { die => $_ });
$schema->storage->ensure_connected;
}, qr/$_/, "$_ exception found");
}
done_testing;
|
