t/25backcompat_v4.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 use File::Path;
   5 use Class::Unload;
   6 use lib qw(t/lib);
   7 use make_dbictest_db2;
   8
   9 my $DUMP_DIR = './t/_common_dump';
  10 rmtree $DUMP_DIR;
  11
  12 sub run_loader {
  13     my %loader_opts = @_;
  14
  15     my $schema_class = 'DBIXCSL_Test::Schema';
  16     Class::Unload->unload($schema_class);
  17
  18     my @connect_info = $make_dbictest_db2::dsn;
  19     my @loader_warnings;
  20     local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
  21     eval qq{
  22         package $schema_class;
  23         use base qw/DBIx::Class::Schema::Loader/;
  24
  25         __PACKAGE__->loader_options(\%loader_opts);
  26         __PACKAGE__->connection(\@connect_info);
  27     };
  28
  29     ok(!$@, "Loader initialization") or diag $@;
  30
  31     my $schema = $schema_class->clone;
  32     my (%monikers, %classes);
  33     foreach my $source_name ($schema->sources) {
  34         my $table_name = $schema->source($source_name)->from;
  35         $monikers{$table_name} = $source_name;
  36         $classes{$table_name}  = "${schema_class}::${source_name}";
  37     }
  38
  39     return {
  40         schema => $schema,
  41         warnings => \@loader_warnings,
  42         monikers => \%monikers,
  43         classes => \%classes,
  44     };
  45 }
  46
  47 # test dynamic schema in 0.04006 mode
  48 {
  49     my $res = run_loader();
  50
  51     like $res->{warnings}[0], qr/dynamic schema/i,
  52         'dynamic schema in backcompat mode detected';
  53     like $res->{warnings}[0], qr/run in 0\.04006 mode/,
  54         'dynamic schema in 0.04006 mode warning';
  55
  56     is_deeply [ @{ $res->{monikers} }{qw/foos bar bazes quuxes/} ],
  57         [qw/Foos Bar Bazes Quuxes/],
  58         'correct monikers in 0.04006 mode';
  59
  60     ok my $bar = eval { $res->{schema}->resultset('Bar')->find(1) };
  61
  62     isa_ok eval { $bar->fooref }, $res->{classes}{foos},
  63         'correct rel name';
  64
  65     ok my $baz  = eval { $res->{schema}->resultset('Bazes')->find(1) };
  66
  67     isa_ok eval { $baz->quuxes }, 'DBIx::Class::ResultSet',
  68         'correct rel type and name for UNIQUE FK';
  69 }
  70
  71 done_testing;
  72
  73 END { rmtree $DUMP_DIR }