t/39load_namespaces_rt41083.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Test::More skip_all => 'Postponed until after 0.08100';
   6
   7 use lib 't/lib';
   8
   9 plan tests => 15;
  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 sub _verify_sources {
  23   my @monikers = @_;
  24   is_deeply (
  25     [ sort DBICNSTest::RtBug41083->sources ],
  26     \@monikers,
  27     'List of resultsource registrations',
  28   );
  29
  30   my %seen_rc;
  31   for my $m (@monikers) {
  32     my $src = DBICNSTest::RtBug41083->source ($m);
  33     my $rc = $src->result_class;
  34
  35     ok ( (++$seen_rc{$rc} == 1), "result_class of $m is unique")
  36       || diag "Source: $m, result_class: $rc";
  37     like ($rc, qr/:: $m $/x, 'result_class matches moniker');
  38   }
  39 }
  40
  41 {
  42   my $warnings;
  43   eval {
  44     local $SIG{__WARN__} = sub { $warnings .= shift };
  45     package DBICNSTest::RtBug41083;
  46     use base 'DBIx::Class::Schema';
  47     __PACKAGE__->load_namespaces(
  48       result_namespace => 'Schema_A',
  49       resultset_namespace => 'ResultSet_A',
  50       default_resultset_class => 'ResultSet'
  51     );
  52   };
  53
  54   ok(!$@) or diag $@;
  55   ok(_chk_warning($warnings), 'expected no resultset complaint');
  56   ok(_chk_extra_sources_warning($warnings), 'expected no extra sources complaint') or diag($warnings);
  57
  58   _verify_sources (qw/A A::Sub/);
  59 }
  60
  61 {
  62   my $warnings;
  63   eval {
  64     local $SIG{__WARN__} = sub { $warnings .= shift };
  65     package DBICNSTest::RtBug41083;
  66     use base 'DBIx::Class::Schema';
  67     __PACKAGE__->load_namespaces(
  68       result_namespace => 'Schema',
  69       resultset_namespace => 'ResultSet',
  70       default_resultset_class => 'ResultSet'
  71     );
  72   };
  73   ok(!$@) or diag $@;
  74   ok(_chk_warning($warnings), 'expected no resultset complaint') or diag $warnings;
  75   ok(_chk_extra_sources_warning($warnings), 'expected no extra sources complaint') or diag($warnings);
  76
  77   _verify_sources (qw/A A::Sub Foo Foo::Sub/);
  78 }