Merge branch 'master' into topic/constructor_rewrite

[dbsrgits/DBIx-Class.git] / t / relationship / info.t

diff --git a/t/relationship/info.t b/t/relationship/info.t
new file mode 100644 (file)
index 0000000..4f349d4
--- /dev/null
+++ b/t/relationship/info.t
@@ -0,0 +1,97 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+#
+# The test must be performed on non-registered result classes
+#
+{
+  package DBICTest::Thing;
+  use warnings;
+  use strict;
+  use base qw/DBIx::Class::Core/;
+  __PACKAGE__->table('thing');
+  __PACKAGE__->add_columns(qw/id ancestor_id/);
+  __PACKAGE__->set_primary_key('id');
+  __PACKAGE__->has_many(children => __PACKAGE__, 'id');
+  __PACKAGE__->belongs_to(parent => __PACKAGE__, 'id', { join_type => 'left' } );
+
+  __PACKAGE__->has_many(subthings => 'DBICTest::SubThing', 'thing_id');
+}
+
+{
+  package DBICTest::SubThing;
+  use warnings;
+  use strict;
+  use base qw/DBIx::Class::Core/;
+  __PACKAGE__->table('subthing');
+  __PACKAGE__->add_columns(qw/thing_id/);
+  __PACKAGE__->belongs_to(thing => 'DBICTest::Thing', 'thing_id');
+  __PACKAGE__->belongs_to(thing2 => 'DBICTest::Thing', 'thing_id', { join_type => 'left' } );
+}
+
+my $schema = DBICTest->init_schema;
+
+for my $without_schema (1,0) {
+
+  my ($t, $s) = $without_schema
+    ? (qw/DBICTest::Thing DBICTest::SubThing/)
+    : do {
+      $schema->register_class(relinfo_thing => 'DBICTest::Thing');
+      $schema->register_class(relinfo_subthing => 'DBICTest::SubThing');
+
+      map { $schema->source ($_) } qw/relinfo_thing relinfo_subthing/;
+    }
+  ;
+
+  is_deeply(
+    [ sort $t->relationships ],
+    [qw/ children parent subthings/],
+    "Correct relationships on $t",
+  );
+
+  is_deeply(
+    [ sort $s->relationships ],
+    [qw/ thing thing2 /],
+    "Correct relationships on $s",
+  );
+
+  is_deeply(
+    _instance($s)->reverse_relationship_info('thing'),
+    { subthings => $t->relationship_info('subthings') },
+    'reverse_rel_info works cross-class belongs_to direction',
+  );
+  is_deeply(
+    _instance($s)->reverse_relationship_info('thing2'),
+    { subthings => $t->relationship_info('subthings') },
+    'reverse_rel_info works cross-class belongs_to direction 2',
+  );
+
+  is_deeply(
+    _instance($t)->reverse_relationship_info('subthings'),
+    { map { $_ => $s->relationship_info($_) } qw/thing thing2/ },
+    'reverse_rel_info works cross-class has_many direction',
+  );
+
+  is_deeply(
+    _instance($t)->reverse_relationship_info('parent'),
+    { children => $t->relationship_info('children') },
+    'reverse_rel_info works in-class belongs_to direction',
+  );
+  is_deeply(
+    _instance($t)->reverse_relationship_info('children'),
+    { parent => $t->relationship_info('parent') },
+    'reverse_rel_info works in-class has_many direction',
+  );
+}
+
+sub _instance {
+  $_[0]->isa('DBIx::Class::ResultSource')
+    ? $_[0]
+    : $_[0]->result_source_instance
+}
+
+done_testing;