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