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   ok ( (not grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "No warning triggered with relevant 'no warnings'");
  31 }
  32
  33 sub gen_code {
  34
  35   my $args = { @_ };
  36   my $suffix = $args->{suffix};
  37   my $no_warn = ( $args->{no_warn}
  38     ? "no warnings 'DBIx::Class::Relationship::ManyToMany';"
  39     : '',
  40   );
  41
  42   return <<EOF;
  43 use strict;
  44 use warnings;
  45
  46 {
  47   package #
  48     DBICTest::Schema::Foo${suffix};
  49   use base 'DBIx::Class::Core';
  50   __PACKAGE__->table('foo');
  51   __PACKAGE__->add_columns(
  52     'fooid' => {
  53       data_type => 'integer',
  54       is_auto_increment => 1,
  55     },
  56   );
  57   __PACKAGE__->set_primary_key('fooid');
  58
  59
  60   __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar${suffix}' => 'bar');
  61   __PACKAGE__->many_to_many( foos => foo_to_bar => 'bar' );
  62 }
  63 {
  64   package #
  65     DBICTest::Schema::FooToBar${suffix};
  66
  67   use base 'DBIx::Class::Core';
  68   __PACKAGE__->table('foo_to_bar');
  69   __PACKAGE__->add_columns(
  70     'foo' => {
  71       data_type => 'integer',
  72     },
  73     'bar' => {
  74       data_type => 'integer',
  75     },
  76   );
  77   __PACKAGE__->belongs_to('foo' => 'DBICTest::Schema::Foo${suffix}');
  78   __PACKAGE__->belongs_to('bar' => 'DBICTest::Schema::Foo${suffix}');
  79 }
  80 {
  81   package #
  82     DBICTest::Schema::Bar${suffix};
  83
  84   use base 'DBIx::Class::Core';
  85   __PACKAGE__->table('bar');
  86   __PACKAGE__->add_columns(
  87     'barid' => {
  88       data_type => 'integer',
  89       is_auto_increment => 1,
  90     },
  91   );
  92
  93   ${no_warn}
  94   __PACKAGE__->set_primary_key('barid');
  95   __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar${suffix}' => 'foo');
  96
  97   __PACKAGE__->many_to_many( bars => foo_to_bar => 'foo' );
  98
  99   sub add_to_bars {}
 100 }
 101 EOF
 102
 103 }