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 => 6;
  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 my $warnings;
  23 eval {
  24   local $SIG{__WARN__} = sub { $warnings .= shift };
  25   package DBICNSTest::RtBug41083;
  26   use base 'DBIx::Class::Schema';
  27   __PACKAGE__->load_namespaces(
  28     result_namespace => 'Schema_A',
  29     resultset_namespace => 'ResultSet_A',
  30     default_resultset_class => 'ResultSet'
  31   );
  32 };
  33 ok(!$@) or diag $@;
  34 ok(_chk_warning($warnings), 'expected no resultset complaint');
  35 ok(_chk_extra_sources_warning($warnings), 'expected no extra sources complaint') or diag($warnings);
  36 undef $warnings;
  37
  38 eval {
  39   local $SIG{__WARN__} = sub { $warnings .= shift };
  40   package DBICNSTest::RtBug41083;
  41   use base 'DBIx::Class::Schema';
  42   __PACKAGE__->load_namespaces(
  43     result_namespace => 'Schema',
  44     resultset_namespace => 'ResultSet',
  45     default_resultset_class => 'ResultSet'
  46   );
  47 };
  48 ok(!$@) or diag $@;
  49 ok(_chk_warning($warnings), 'expected no resultset complaint') or diag $warnings;
  50 ok(_chk_extra_sources_warning($warnings), 'expected no extra sources complaint') or diag($warnings);
  51 undef $warnings;