xt/extra/c3_mro.t

   1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
   2
   3 use warnings;
   4 use strict;
   5
   6 use Test::More;
   7 use DBICTest;
   8
   9 my @global_ISA_tail = qw(
  10   DBIx::Class
  11   DBIx::Class::Componentised
  12   Class::C3::Componentised
  13   DBIx::Class::AccessorGroup
  14   Class::Accessor::Grouped
  15 );
  16
  17 is(
  18   mro::get_mro('DBIx::Class'),
  19   'c3',
  20   'Correct mro on base class DBIx::Class',
  21 );
  22
  23 {
  24   package AAA;
  25
  26   use base "DBIx::Class::Core";
  27 }
  28
  29 {
  30   package BBB;
  31
  32   use base 'AAA';
  33
  34   #Injecting a direct parent.
  35   __PACKAGE__->inject_base( __PACKAGE__, 'AAA' );
  36 }
  37
  38 {
  39   package CCC;
  40
  41   use base 'AAA';
  42
  43   #Injecting an indirect parent.
  44   __PACKAGE__->inject_base( __PACKAGE__, 'DBIx::Class::Core' );
  45 }
  46
  47 eval { mro::get_linear_isa('BBB'); };
  48 ok (! $@, "Correctly skipped injecting a direct parent of class BBB");
  49
  50 eval { mro::get_linear_isa('CCC'); };
  51 ok (! $@, "Correctly skipped injecting an indirect parent of class BBB");
  52
  53
  54 my $art = DBICTest->init_schema->resultset("Artist")->next;
  55
  56 check_ancestry($_) for (
  57   ref( $art ),
  58   ref( $art->result_source ),
  59   ref( $art->result_source->resultset ),
  60   ref( $art->result_source->schema ),
  61   qw( AAA BBB CCC ),
  62 );
  63
  64 use DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server;
  65
  66 is_deeply (
  67   mro::get_linear_isa('DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server'),
  68   [qw/
  69     DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server
  70     DBIx::Class::Storage::DBI::Sybase
  71     DBIx::Class::Storage::DBI::MSSQL
  72     DBIx::Class::Storage::DBI::UniqueIdentifier
  73     DBIx::Class::Storage::DBI::IdentityInsert
  74     DBIx::Class::Storage::DBI
  75     DBIx::Class::Storage::DBIHacks
  76     DBIx::Class::Storage
  77   /, @global_ISA_tail],
  78   'Correctly ordered ISA of DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server'
  79 );
  80
  81 my $storage = DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server->new;
  82 $storage->connect_info(['dbi:SQLite::memory:']); # determine_driver's init() connects for this subclass
  83 $storage->_determine_driver;
  84 is (
  85   $storage->can('sql_limit_dialect'),
  86   'DBIx::Class::Storage::DBI::MSSQL'->can('sql_limit_dialect'),
  87   'Correct method picked'
  88 );
  89
  90 if ( "$]" >= 5.010 ) {
  91   ok (! $INC{'Class/C3.pm'}, 'No Class::C3 loaded on perl 5.10+');
  92
  93   # Class::C3::Componentised loads MRO::Compat unconditionally to satisfy
  94   # the assumption that once Class::C3::X is loaded, so is Class::C3
  95   #ok (! $INC{'MRO/Compat.pm'}, 'No MRO::Compat loaded on perl 5.10+');
  96 }
  97
  98 sub check_ancestry {
  99   my $class = shift;
 100
 101   die "Expecting classname" if length ref $class;
 102
 103   my @linear_ISA = @{ mro::get_linear_isa($class) };
 104
 105   # something is *VERY* wrong, the splice below won't make it
 106   unless (@linear_ISA > @global_ISA_tail) {
 107     fail(
 108       "Unexpectedly shallow \@ISA for class '$class': "
 109     . join ', ', map { "'$_'" } @linear_ISA
 110     );
 111     return;
 112   }
 113
 114   is_deeply (
 115     [ splice @linear_ISA, ($#linear_ISA - $#global_ISA_tail) ],
 116     \@global_ISA_tail,
 117     "Correct end of \@ISA for '$class'"
 118   );
 119
 120   # check the remainder
 121   for my $c (@linear_ISA) {
 122     # nothing to see there
 123     next if $c =~ /^DBICTest::/;
 124
 125     next if mro::get_mro($c) eq 'c3';
 126
 127     fail( "Incorrect mro '@{[ mro::get_mro($c) ]}' on '$c' (parent of '$class')" );
 128   }
 129 }
 130
 131 done_testing;