t/39load_namespaces_rt41083.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 't/lib';
   7 use DBICTest; # do not remove even though it is not used
   8 use Test::More tests => 8;
   9
  10 sub _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
  16 sub _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
  21 sub _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 }