1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use lib 't/lib';
7use DBICTest; # do not remove even though it is not used 
8use Test::More tests => 8;
9
10sub _chk_warning {
11  defined $_[0]?
12    $_[0] !~ qr/We found ResultSet class '([^']+)' for '([^']+)', but it seems that you had already set '([^']+)' to use '([^']+)' instead/ :
13    1
14}
15
16sub _chk_extra_sources_warning {
17  my $p = qr/already has a source, use register_extra_source for additional sources/;
18  defined $_[0]? $_[0] !~ /$p/ : 1;
19}
20
21sub _verify_sources {
22  my @monikers = @_;
23  is_deeply (
24    [ sort DBICNSTest::RtBug41083->sources ],
25    \@monikers,
26    'List of resultsource registrations',
27  );
28}
29
30{
31  my $warnings;
32  eval {
33    local $SIG{__WARN__} = sub { $warnings .= shift };
34    package DBICNSTest::RtBug41083;
35    use base 'DBIx::Class::Schema';
36    __PACKAGE__->load_namespaces(
37      result_namespace => 'Schema_A',
38      resultset_namespace => 'ResultSet_A',
39      default_resultset_class => 'ResultSet'
40    );
41  };
42
43  ok(!$@) or diag $@;
44  ok(_chk_warning($warnings), 'expected no resultset complaint');
45  ok(_chk_extra_sources_warning($warnings), 'expected no extra sources complaint') or diag($warnings);
46
47  _verify_sources (qw/A A::Sub/);
48}
49
50{
51  my $warnings;
52  eval {
53    local $SIG{__WARN__} = sub { $warnings .= shift };
54    package DBICNSTest::RtBug41083;
55    use base 'DBIx::Class::Schema';
56    __PACKAGE__->load_namespaces(
57      result_namespace => 'Schema',
58      resultset_namespace => 'ResultSet',
59      default_resultset_class => 'ResultSet'
60    );
61  };
62  ok(!$@) or diag $@;
63  ok(_chk_warning($warnings), 'expected no resultset complaint') or diag $warnings;
64  ok(_chk_extra_sources_warning($warnings), 'expected no extra sources complaint') or diag($warnings);
65
66  _verify_sources (qw/A A::Sub Foo Foo::Sub/);
67}
68