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