X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xt%2Fextra%2Fc3_mro.t;h=27a034145de9c24f09aad044bd8a6d08f71c6d49;hb=5e0eea3522876a30453af24097507198bbbc9409;hp=55effb5a9f399912ebbbda445fb7f7367319e405;hpb=750a4ad26c8fbe0f513a3abd4a9cb79ef8f40884;p=dbsrgits%2FDBIx-Class.git

diff --git a/xt/extra/c3_mro.t b/xt/extra/c3_mro.t
index 55effb5..27a0341 100644
--- a/xt/extra/c3_mro.t
+++ b/xt/extra/c3_mro.t
@@ -1,10 +1,25 @@
+BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
+
 use warnings;
 use strict;
 
 use Test::More;
+use DBICTest;
+use DBIx::Class::Optional::Dependencies;
+
+my @global_ISA_tail = qw(
+  DBIx::Class
+  DBIx::Class::Componentised
+  Class::C3::Componentised
+  DBIx::Class::AccessorGroup
+  Class::Accessor::Grouped
+);
 
-use lib qw(t/lib);
-use DBICTest; # do not remove even though it is not used (pulls in MRO::Compat if needed)
+is(
+  mro::get_mro('DBIx::Class'),
+  'c3',
+  'Correct mro on base class DBIx::Class',
+);
 
 {
   package AAA;
@@ -36,6 +51,23 @@ ok (! $@, "Correctly skipped injecting a direct parent of class BBB");
 eval { mro::get_linear_isa('CCC'); };
 ok (! $@, "Correctly skipped injecting an indirect parent of class BBB");
 
+
+my $art = DBICTest->init_schema->resultset("Artist")->next;
+
+check_ancestry($_) for (
+  ref( $art ),
+  ref( $art->result_source ),
+  ref( $art->result_source->resultset ),
+  ref( $art->result_source->schema ),
+  qw( AAA BBB CCC ),
+  ((! DBIx::Class::Optional::Dependencies->req_ok_for('cdbicompat') ) ? () : do {
+    unshift @INC, 't/cdbi/testlib';
+    map { eval "require $_" or die $@; $_ } qw(
+      Film Lazy Actor ActorAlias ImplicitInflate
+    );
+  }),
+);
+
 use DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server;
 
 is_deeply (
@@ -49,12 +81,7 @@ is_deeply (
     DBIx::Class::Storage::DBI
     DBIx::Class::Storage::DBIHacks
     DBIx::Class::Storage
-    DBIx::Class
-    DBIx::Class::Componentised
-    Class::C3::Componentised
-    DBIx::Class::AccessorGroup
-    Class::Accessor::Grouped
-  /],
+  /, @global_ISA_tail],
   'Correctly ordered ISA of DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server'
 );
 
@@ -75,4 +102,37 @@ if ( "$]" >= 5.010 ) {
   #ok (! $INC{'MRO/Compat.pm'}, 'No MRO::Compat loaded on perl 5.10+');
 }
 
+sub check_ancestry {
+  my $class = shift;
+
+  die "Expecting classname" if length ref $class;
+
+  my @linear_ISA = @{ mro::get_linear_isa($class) };
+
+  # something is *VERY* wrong, the splice below won't make it
+  unless (@linear_ISA > @global_ISA_tail) {
+    fail(
+      "Unexpectedly shallow \@ISA for class '$class': "
+    . join ', ', map { "'$_'" } @linear_ISA
+    );
+    return;
+  }
+
+  is_deeply (
+    [ splice @linear_ISA, ($#linear_ISA - $#global_ISA_tail) ],
+    \@global_ISA_tail,
+    "Correct end of \@ISA for '$class'"
+  );
+
+  # check the remainder
+  for my $c (@linear_ISA) {
+    # nothing to see there
+    next if $c =~ /^DBICTest::/;
+
+    next if mro::get_mro($c) eq 'c3';
+
+    fail( "Incorrect mro '@{[ mro::get_mro($c) ]}' on '$c' (parent of '$class')" );
+  }
+}
+
 done_testing;