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