t/103many_to_many_warning.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4
   5 use lib qw(t/lib);
   6 use Data::Dumper;
   7
   8 plan ( ($] >= 5.009000 and $] < 5.010001)
   9   ? (skip_all => 'warnings::register broken under 5.10: http://rt.perl.org/rt3/Public/Bug/Display.html?id=62522')
  10   : (tests => 2)
  11 );
  12
  13 {
  14   my @w;
  15   local $SIG{__WARN__} = sub { push @w, @_ };
  16
  17   my $code = gen_code ( suffix => 1 );
  18   eval "$code";
  19
  20   ok ( (grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "Warning triggered without relevant 'no warnings'");
  21 }
  22
  23 {
  24   my @w;
  25   local $SIG{__WARN__} = sub { push @w, @_ };
  26
  27   my $code = gen_code ( suffix => 2, no_warn => 1 );
  28   eval "$code";
  29
  30 diag Dumper \@w;
  31
  32   ok ( (not grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "No warning triggered with relevant 'no warnings'");
  33 }
  34
  35 sub gen_code {
  36
  37   my $args = { @_ };
  38   my $suffix = $args->{suffix};
  39   my $no_warn = ( $args->{no_warn}
  40     ? "no warnings 'DBIx::Class::Relationship::ManyToMany';"
  41     : '',
  42   );
  43
  44   return <<EOF;
  45 use strict;
  46 use warnings;
  47
  48 {
  49   package #
  50     DBICTest::Schema::Foo${suffix};
  51   use base 'DBIx::Class::Core';
  52   __PACKAGE__->table('foo');
  53   __PACKAGE__->add_columns(
  54     'fooid' => {
  55       data_type => 'integer',
  56       is_auto_increment => 1,
  57     },
  58   );
  59   __PACKAGE__->set_primary_key('fooid');
  60
  61
  62   __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar${suffix}' => 'bar');
  63   __PACKAGE__->many_to_many( foos => foo_to_bar => 'bar' );
  64 }
  65 {
  66   package #
  67     DBICTest::Schema::FooToBar${suffix};
  68
  69   use base 'DBIx::Class::Core';
  70   __PACKAGE__->table('foo_to_bar');
  71   __PACKAGE__->add_columns(
  72     'foo' => {
  73       data_type => 'integer',
  74     },
  75     'bar' => {
  76       data_type => 'integer',
  77     },
  78   );
  79   __PACKAGE__->belongs_to('foo' => 'DBICTest::Schema::Foo${suffix}');
  80   __PACKAGE__->belongs_to('bar' => 'DBICTest::Schema::Foo${suffix}');
  81 }
  82 {
  83   package #
  84     DBICTest::Schema::Bar${suffix};
  85
  86   use base 'DBIx::Class::Core';
  87   __PACKAGE__->table('bar');
  88   __PACKAGE__->add_columns(
  89     'barid' => {
  90       data_type => 'integer',
  91       is_auto_increment => 1,
  92     },
  93   );
  94
  95   ${no_warn}
  96   __PACKAGE__->set_primary_key('barid');
  97   __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar${suffix}' => 'foo');
  98
  99   __PACKAGE__->many_to_many( bars => foo_to_bar => 'foo' );
 100
 101   sub add_to_bars {}
 102 }
 103 EOF
 104
 105 }