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     Class::Accessor::Grouped
  55   /],
  56   'Correctly ordered ISA of DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server'
  57 );
  58
  59 my $storage = DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server->new;
  60 $storage->_determine_driver;
  61 is (
  62   $storage->can('sql_limit_dialect'),
  63   'DBIx::Class::Storage::DBI::MSSQL'->can('sql_limit_dialect'),
  64   'Correct method picked'
  65 );
  66
  67 if ($] >= 5.010) {
  68   ok (! $INC{'Class/C3.pm'}, 'No Class::C3 loaded on perl 5.10+');
  69
  70   # Class::C3::Componentised loads MRO::Compat unconditionally to satisfy
  71   # the assumption that once Class::C3::X is loaded, so is Class::C3
  72   #ok (! $INC{'MRO/Compat.pm'}, 'No MRO::Compat loaded on perl 5.10+');
  73 }
  74
  75 done_testing;