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