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
45
46
47
48
|
use strict;
use warnings;
use Test::More;
use lib qw(t/lib);
use make_dbictest_db;
my %loader_class = (
'TestLoaderSubclass' => 'TestLoaderSubclass',
'TestLoaderSubclass_NoRebless' => 'TestLoaderSubclass_NoRebless',
'::DBI::SQLite' => 'DBIx::Class::Schema::Loader::DBI::SQLite'
);
my %invocations = (
loader_class => sub {
package DBICTest::Schema::1;
use base qw/ DBIx::Class::Schema::Loader /;
__PACKAGE__->_loader_invoked(0);
__PACKAGE__->naming('current');
__PACKAGE__->loader_class(shift);
__PACKAGE__->connect($make_dbictest_db::dsn);
},
connect_info => sub {
package DBICTeset::Schema::2;
use base qw/ DBIx::Class::Schema::Loader /;
__PACKAGE__->_loader_invoked(0);
__PACKAGE__->naming('current');
__PACKAGE__->connect($make_dbictest_db::dsn, { loader_class => shift });
},
make_schema_at => sub {
use DBIx::Class::Schema::Loader qw/ make_schema_at /;
make_schema_at(
'DBICTeset::Schema::3',
{ naming => 'current' },
[ $make_dbictest_db::dsn, { loader_class => shift } ]
);
}
);
# one test per invocation/class combo
plan tests => keys(%invocations) * keys(%loader_class);
while (my ($style,$subref) = each %invocations) {
while (my ($arg, $class) = each %loader_class) {
my $schema = $subref->($arg);
$schema = $schema->clone unless ref $schema;
isa_ok($schema->loader, $class, "$style($arg)");
}
}
|
