1use strict; 2use warnings; 3use Test::More; 4use lib qw(t/lib); 5use make_dbictest_db; 6 7my %loader_class = ( 'TestLoaderSubclass' => 'TestLoaderSubclass', 8 '::DBI::SQLite' => 'DBIx::Class::Schema::Loader::DBI::SQLite' 9 ); 10 11my %invocations = ( 12 loader_class => sub { 13 package DBICTest::Schema::1; 14 use base qw/ DBIx::Class::Schema::Loader /; 15 __PACKAGE__->naming('current'); 16 __PACKAGE__->loader_class(shift); 17 __PACKAGE__->connect($make_dbictest_db::dsn); 18 }, 19 connect_info => sub { 20 package DBICTeset::Schema::2; 21 use base qw/ DBIx::Class::Schema::Loader /; 22 __PACKAGE__->naming('current'); 23 __PACKAGE__->connect($make_dbictest_db::dsn, { loader_class => shift }); 24 }, 25 make_schema_at => sub { 26 use DBIx::Class::Schema::Loader qw/ make_schema_at /; 27 make_schema_at( 28 'DBICTeset::Schema::3', 29 { naming => 'current' }, 30 [ $make_dbictest_db::dsn, { loader_class => shift } ] 31 ); 32 } 33); 34 35# one test per invocation/class combo 36plan tests => keys(%invocations) * keys(%loader_class); 37 38while (my ($style,$subref) = each %invocations) { 39 while (my ($arg, $class) = each %loader_class) { 40 my $schema = $subref->($arg); 41 $schema = $schema->clone unless ref $schema; 42 isa_ok($schema->_loader, $class, "$style($arg)"); 43 } 44} 45