1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
9 my @global_ISA_tail = qw(
11 DBIx::Class::Componentised
12 Class::C3::Componentised
13 DBIx::Class::AccessorGroup
14 Class::Accessor::Grouped
18 mro::get_mro('DBIx::Class'),
20 'Correct mro on base class DBIx::Class',
26 use base "DBIx::Class::Core";
34 #Injecting a direct parent.
35 __PACKAGE__->inject_base( __PACKAGE__, 'AAA' );
43 #Injecting an indirect parent.
44 __PACKAGE__->inject_base( __PACKAGE__, 'DBIx::Class::Core' );
47 eval { mro::get_linear_isa('BBB'); };
48 ok (! $@, "Correctly skipped injecting a direct parent of class BBB");
50 eval { mro::get_linear_isa('CCC'); };
51 ok (! $@, "Correctly skipped injecting an indirect parent of class BBB");
54 my $art = DBICTest->init_schema->resultset("Artist")->next;
56 check_ancestry($_) for (
58 ref( $art->result_source ),
59 ref( $art->result_source->resultset ),
60 ref( $art->result_source->schema ),
64 use DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server;
67 mro::get_linear_isa('DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server'),
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
78 'Correctly ordered ISA of DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server'
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;
85 $storage->can('sql_limit_dialect'),
86 'DBIx::Class::Storage::DBI::MSSQL'->can('sql_limit_dialect'),
87 'Correct method picked'
90 if ( "$]" >= 5.010 ) {
91 ok (! $INC{'Class/C3.pm'}, 'No Class::C3 loaded on perl 5.10+');
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+');
101 die "Expecting classname" if length ref $class;
103 my @linear_ISA = @{ mro::get_linear_isa($class) };
105 # something is *VERY* wrong, the splice below won't make it
106 unless (@linear_ISA > @global_ISA_tail) {
108 "Unexpectedly shallow \@ISA for class '$class': "
109 . join ', ', map { "'$_'" } @linear_ISA
115 [ splice @linear_ISA, ($#linear_ISA - $#global_ISA_tail) ],
117 "Correct end of \@ISA for '$class'"
120 # check the remainder
121 for my $c (@linear_ISA) {
122 # nothing to see there
123 next if $c =~ /^DBICTest::/;
125 next if mro::get_mro($c) eq 'c3';
127 fail( "Incorrect mro '@{[ mro::get_mro($c) ]}' on '$c' (parent of '$class')" );