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__->_loader_invoked(0);
  18         __PACKAGE__->naming('current');
  19         __PACKAGE__->loader_class(shift);
  20         __PACKAGE__->connect($make_dbictest_db::dsn);
  21     },
  22     connect_info => sub {
  23         package DBICTeset::Schema::2;
  24         use base qw/ DBIx::Class::Schema::Loader /;
  25         __PACKAGE__->_loader_invoked(0);
  26         __PACKAGE__->naming('current');
  27         __PACKAGE__->connect($make_dbictest_db::dsn, { loader_class => shift });
  28     },
  29     make_schema_at => sub {
  30         use DBIx::Class::Schema::Loader qw/ make_schema_at /;
  31         make_schema_at(
  32             'DBICTeset::Schema::3',
  33             { naming => 'current' },
  34             [ $make_dbictest_db::dsn, { loader_class => shift } ]
  35         );
  36     }
  37 );
  38
  39 # one test per invocation/class combo
  40 plan tests => keys(%invocations) * keys(%loader_class);
  41
  42 while (my ($style,$subref) = each %invocations) {
  43     while (my ($arg, $class) = each %loader_class) {
  44         my $schema = $subref->($arg);
  45         $schema = $schema->clone unless ref $schema;
  46         isa_ok($schema->loader, $class, "$style($arg)");
  47     }
  48 }