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