t/04_c3_mro.t

   1 use warnings;
   2 use strict;
   3
   4 use Test::More;
   5
   6 use lib qw(t/lib);
   7 use DBICTest; # do not remove even though it is not used (pulls in MRO::Compat if needed)
   8
   9 {
  10   package AAA;
  11
  12   use base "DBIx::Class::Core";
  13 }
  14
  15 {
  16   package BBB;
  17
  18   use base 'AAA';
  19
  20   #Injecting a direct parent.
  21   __PACKAGE__->inject_base( __PACKAGE__, 'AAA' );
  22 }
  23
  24 {
  25   package CCC;
  26
  27   use base 'AAA';
  28
  29   #Injecting an indirect parent.
  30   __PACKAGE__->inject_base( __PACKAGE__, 'DBIx::Class::Core' );
  31 }
  32
  33 eval { mro::get_linear_isa('BBB'); };
  34 ok (! $@, "Correctly skipped injecting a direct parent of class BBB");
  35
  36 eval { mro::get_linear_isa('CCC'); };
  37 ok (! $@, "Correctly skipped injecting an indirect parent of class BBB");
  38
  39 use DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server;
  40
  41 is_deeply (
  42   mro::get_linear_isa('DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server'),
  43   [qw/
  44     DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server
  45     DBIx::Class::Storage::DBI::Sybase
  46     DBIx::Class::Storage::DBI::MSSQL
  47     DBIx::Class::Storage::DBI::UniqueIdentifier
  48     DBIx::Class::Storage::DBI
  49     DBIx::Class::Storage::DBIHacks
  50     DBIx::Class::Storage
  51     DBIx::Class
  52     DBIx::Class::Componentised
  53     Class::C3::Componentised
  54     DBIx::Class::AccessorGroup
  55     Class::Accessor::Grouped
  56   /],
  57   'Correctly ordered ISA of DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server'
  58 );
  59
  60 my $storage = DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server->new;
  61 $storage->connect_info(['dbi:SQLite::memory:']); # determine_driver's init() connects for this subclass
  62 $storage->_determine_driver;
  63 is (
  64   $storage->can('sql_limit_dialect'),
  65   'DBIx::Class::Storage::DBI::MSSQL'->can('sql_limit_dialect'),
  66   'Correct method picked'
  67 );
  68
  69 if ($] >= 5.010) {
  70   ok (! $INC{'Class/C3.pm'}, 'No Class::C3 loaded on perl 5.10+');
  71
  72   # Class::C3::Componentised loads MRO::Compat unconditionally to satisfy
  73   # the assumption that once Class::C3::X is loaded, so is Class::C3
  74   #ok (! $INC{'MRO/Compat.pm'}, 'No MRO::Compat loaded on perl 5.10+');
  75 }
  76
  77 done_testing;