t/39load_namespaces_rt41083.t

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