Factor out bindattr resolver and tighten code a bit
[dbsrgits/DBIx-Class.git] / t / relationship / info.t
CommitLineData
1e0daa97 1use strict;
2use warnings;
3
4bea1fe7 4use Test::More;
5use lib qw(t/lib);
6use DBICTest;
7
1e0daa97 8#
9# The test must be performed on non-registered result classes
10#
11{
12 package DBICTest::Thing;
13 use warnings;
14 use strict;
15 use base qw/DBIx::Class::Core/;
16 __PACKAGE__->table('thing');
17 __PACKAGE__->add_columns(qw/id ancestor_id/);
18 __PACKAGE__->set_primary_key('id');
19 __PACKAGE__->has_many(children => __PACKAGE__, 'id');
20 __PACKAGE__->belongs_to(parent => __PACKAGE__, 'id', { join_type => 'left' } );
21
22 __PACKAGE__->has_many(subthings => 'DBICTest::SubThing', 'thing_id');
23}
24
25{
26 package DBICTest::SubThing;
27 use warnings;
28 use strict;
29 use base qw/DBIx::Class::Core/;
30 __PACKAGE__->table('subthing');
31 __PACKAGE__->add_columns(qw/thing_id/);
32 __PACKAGE__->belongs_to(thing => 'DBICTest::Thing', 'thing_id');
33 __PACKAGE__->belongs_to(thing2 => 'DBICTest::Thing', 'thing_id', { join_type => 'left' } );
34}
35
1e0daa97 36my $schema = DBICTest->init_schema;
37
38for my $without_schema (1,0) {
39
40 my ($t, $s) = $without_schema
41 ? (qw/DBICTest::Thing DBICTest::SubThing/)
42 : do {
43 $schema->register_class(relinfo_thing => 'DBICTest::Thing');
44 $schema->register_class(relinfo_subthing => 'DBICTest::SubThing');
45
46 map { $schema->source ($_) } qw/relinfo_thing relinfo_subthing/;
47 }
48 ;
49
50 is_deeply(
51 [ sort $t->relationships ],
52 [qw/ children parent subthings/],
53 "Correct relationships on $t",
54 );
55
56 is_deeply(
57 [ sort $s->relationships ],
58 [qw/ thing thing2 /],
59 "Correct relationships on $s",
60 );
61
62 is_deeply(
63 _instance($s)->reverse_relationship_info('thing'),
64 { subthings => $t->relationship_info('subthings') },
65 'reverse_rel_info works cross-class belongs_to direction',
66 );
67 is_deeply(
68 _instance($s)->reverse_relationship_info('thing2'),
69 { subthings => $t->relationship_info('subthings') },
70 'reverse_rel_info works cross-class belongs_to direction 2',
71 );
72
73 is_deeply(
74 _instance($t)->reverse_relationship_info('subthings'),
75 { map { $_ => $s->relationship_info($_) } qw/thing thing2/ },
76 'reverse_rel_info works cross-class has_many direction',
77 );
78
79 is_deeply(
80 _instance($t)->reverse_relationship_info('parent'),
81 { children => $t->relationship_info('children') },
82 'reverse_rel_info works in-class belongs_to direction',
83 );
84 is_deeply(
85 _instance($t)->reverse_relationship_info('children'),
86 { parent => $t->relationship_info('parent') },
87 'reverse_rel_info works in-class has_many direction',
88 );
89}
90
91sub _instance {
92 $_[0]->isa('DBIx::Class::ResultSource')
93 ? $_[0]
94 : $_[0]->result_source_instance
95}
96
97done_testing;