Commit | Line | Data |
c0329273 |
1 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
2 | |
e8b77df6 |
3 | use warnings; |
e4c24739 |
4 | use strict; |
e8b77df6 |
5 | |
6 | use Test::More; |
d009cb7d |
7 | use DBICTest; |
5e0eea35 |
8 | use DBIx::Class::Optional::Dependencies; |
d009cb7d |
9 | |
10 | my @global_ISA_tail = qw( |
11 | DBIx::Class |
12 | DBIx::Class::Componentised |
13 | Class::C3::Componentised |
14 | DBIx::Class::AccessorGroup |
5f48fa56 |
15 | DBIx::Class::MethodAttributes |
d009cb7d |
16 | Class::Accessor::Grouped |
17 | ); |
e4c24739 |
18 | |
d009cb7d |
19 | is( |
983f766d |
20 | mro::get_mro($_), |
d009cb7d |
21 | 'c3', |
983f766d |
22 | "Correct mro on base class '$_'", |
23 | ) for grep { $_ =~ /^DBIx::Class/ } @global_ISA_tail; |
d8190011 |
24 | |
e4c24739 |
25 | { |
e8b77df6 |
26 | package AAA; |
e4c24739 |
27 | |
e8b77df6 |
28 | use base "DBIx::Class::Core"; |
29 | } |
e4c24739 |
30 | |
e8b77df6 |
31 | { |
32 | package BBB; |
e4c24739 |
33 | |
e8b77df6 |
34 | use base 'AAA'; |
e4c24739 |
35 | |
e8b77df6 |
36 | #Injecting a direct parent. |
37 | __PACKAGE__->inject_base( __PACKAGE__, 'AAA' ); |
38 | } |
e4c24739 |
39 | |
e8b77df6 |
40 | { |
41 | package CCC; |
e4c24739 |
42 | |
e8b77df6 |
43 | use base 'AAA'; |
e4c24739 |
44 | |
e8b77df6 |
45 | #Injecting an indirect parent. |
46 | __PACKAGE__->inject_base( __PACKAGE__, 'DBIx::Class::Core' ); |
e4c24739 |
47 | } |
48 | |
4f507947 |
49 | eval { mro::get_linear_isa('BBB'); }; |
e4c24739 |
50 | ok (! $@, "Correctly skipped injecting a direct parent of class BBB"); |
51 | |
4f507947 |
52 | eval { mro::get_linear_isa('CCC'); }; |
e4c24739 |
53 | ok (! $@, "Correctly skipped injecting an indirect parent of class BBB"); |
e8b77df6 |
54 | |
d009cb7d |
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 ), |
7f068248 |
63 | ( map |
64 | { ref $art->result_source->schema->source($_) } |
65 | $art->result_source->schema->sources |
66 | ), |
d009cb7d |
67 | qw( AAA BBB CCC ), |
5e0eea35 |
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 | }), |
d009cb7d |
74 | ); |
75 | |
e8b77df6 |
76 | use DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server; |
e8b77df6 |
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 |
fabbd5cc |
85 | DBIx::Class::Storage::DBI::IdentityInsert |
e8b77df6 |
86 | DBIx::Class::Storage::DBI |
87 | DBIx::Class::Storage::DBIHacks |
88 | DBIx::Class::Storage |
d009cb7d |
89 | /, @global_ISA_tail], |
e8b77df6 |
90 | 'Correctly ordered ISA of DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server' |
91 | ); |
92 | |
87bf71d5 |
93 | my $storage = DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server->new; |
c1e5a9ac |
94 | $storage->connect_info(['dbi:SQLite::memory:']); # determine_driver's init() connects for this subclass |
87bf71d5 |
95 | $storage->_determine_driver; |
e8b77df6 |
96 | is ( |
87bf71d5 |
97 | $storage->can('sql_limit_dialect'), |
98 | 'DBIx::Class::Storage::DBI::MSSQL'->can('sql_limit_dialect'), |
e8b77df6 |
99 | 'Correct method picked' |
100 | ); |
101 | |
750a4ad2 |
102 | if ( "$]" >= 5.010 ) { |
87bf71d5 |
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 | |
d009cb7d |
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 | |
e8b77df6 |
143 | done_testing; |