Commit | Line | Data |
f5ceba67 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
6882de2b |
5 | use Test::More skip_all => 'Postponed until after 0.08100'; |
f5ceba67 |
6 | |
7 | use lib 't/lib'; |
8 | |
4cf8bfe6 |
9 | =begin |
10 | |
11 | How did this get back here? The test is borked, there is a branch with |
12 | the correct test and a tentative fix - branches/subclassed_rsset |
13 | |
14 | Make sure to nuke this file when merging, it is only left here to make |
15 | merging of the above branch easier. |
16 | |
17 | |
18 | ribasushi |
19 | |
20 | |
21 | =cut |
22 | |
23 | |
24 | __END__ |
25 | |
26 | |
27 | |
f5ceba67 |
28 | plan tests => 15; |
29 | |
30 | sub _chk_warning { |
31 | defined $_[0]? |
32 | $_[0] !~ qr/We found ResultSet class '([^']+)' for '([^']+)', but it seems that you had already set '([^']+)' to use '([^']+)' instead/ : |
33 | 1 |
34 | } |
35 | |
36 | sub _chk_extra_sources_warning { |
37 | my $p = qr/already has a source, use register_extra_source for additional sources/; |
38 | defined $_[0]? $_[0] !~ /$p/ : 1; |
39 | } |
40 | |
41 | sub _verify_sources { |
42 | my @monikers = @_; |
43 | is_deeply ( |
44 | [ sort DBICNSTest::RtBug41083->sources ], |
45 | \@monikers, |
46 | 'List of resultsource registrations', |
47 | ); |
48 | |
49 | my %seen_rc; |
50 | for my $m (@monikers) { |
51 | my $src = DBICNSTest::RtBug41083->source ($m); |
52 | my $rc = $src->result_class; |
53 | |
54 | ok ( (++$seen_rc{$rc} == 1), "result_class of $m is unique") |
55 | || diag "Source: $m, result_class: $rc"; |
56 | like ($rc, qr/:: $m $/x, 'result_class matches moniker'); |
57 | } |
58 | } |
59 | |
60 | { |
61 | my $warnings; |
62 | eval { |
63 | local $SIG{__WARN__} = sub { $warnings .= shift }; |
64 | package DBICNSTest::RtBug41083; |
65 | use base 'DBIx::Class::Schema'; |
66 | __PACKAGE__->load_namespaces( |
67 | result_namespace => 'Schema_A', |
68 | resultset_namespace => 'ResultSet_A', |
69 | default_resultset_class => 'ResultSet' |
70 | ); |
71 | }; |
72 | |
73 | ok(!$@) or diag $@; |
74 | ok(_chk_warning($warnings), 'expected no resultset complaint'); |
75 | ok(_chk_extra_sources_warning($warnings), 'expected no extra sources complaint') or diag($warnings); |
76 | |
77 | _verify_sources (qw/A A::Sub/); |
78 | } |
79 | |
80 | { |
81 | my $warnings; |
82 | eval { |
83 | local $SIG{__WARN__} = sub { $warnings .= shift }; |
84 | package DBICNSTest::RtBug41083; |
85 | use base 'DBIx::Class::Schema'; |
86 | __PACKAGE__->load_namespaces( |
87 | result_namespace => 'Schema', |
88 | resultset_namespace => 'ResultSet', |
89 | default_resultset_class => 'ResultSet' |
90 | ); |
91 | }; |
92 | ok(!$@) or diag $@; |
93 | ok(_chk_warning($warnings), 'expected no resultset complaint') or diag $warnings; |
94 | ok(_chk_extra_sources_warning($warnings), 'expected no extra sources complaint') or diag($warnings); |
95 | |
96 | _verify_sources (qw/A A::Sub Foo Foo::Sub/); |
97 | } |