t/24loader_subclass.t

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