use lib qw(t/lib);
+plan tests => 4;
+my $exp_warn = qr/The many-to-many relationship 'bars' is trying to create/;
-our $no_warn = "";
-our $suffix = "";
-
-plan tests => 2;
{
- local $@;
- local $SIG{__WARN__} = sub { die @_ };
- eval "@{[code()]}";
- like($@, qr/The many-to-many relationship bars/,
- "Warning triggered without relevant 'no warnings'");
+ my @w;
+ local $SIG{__WARN__} = sub { $_[0] =~ $exp_warn ? push @w, $_[0] : warn $_[0] };
+ my $code = gen_code ( suffix => 1 );
+ eval "$code";
+ ok (! $@, 'Eval code without warnings suppression')
+ || diag $@;
+
+ ok (@w, "Warning triggered without DBIC_OVERWRITE_HELPER_METHODS_OK");
}
{
+ my @w;
+ local $SIG{__WARN__} = sub { $_[0] =~ $exp_warn ? push @w, $_[0] : warn $_[0] };
+
+ my $code = gen_code ( suffix => 2 );
- $no_warn = "no warnings 'DBIx::Class::Relationship::ManyToMany';";
- $suffix = "2";
- local $SIG{__WARN__} = sub { die @_ };
- eval "@{[code()]}";
- unlike($@, qr/The many-to-many relationship bars.*?Bar2/s,
- "No warning triggered with relevant 'no warnings'");
+ local $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK} = 1;
+ eval "$code";
+ ok (! $@, 'Eval code with warnings suppression')
+ || diag $@;
+
+ ok (! @w, "No warning triggered with DBIC_OVERWRITE_HELPER_METHODS_OK");
}
-sub code {
-my $file = << "EOF";
+sub gen_code {
+
+ my $args = { @_ };
+ my $suffix = $args->{suffix};
+
+ return <<EOF;
use strict;
use warnings;
{
package #
- DBICTest::Schema::Foo$suffix;
+ DBICTest::Schema::Foo${suffix};
use base 'DBIx::Class::Core';
+
__PACKAGE__->table('foo');
__PACKAGE__->add_columns(
'fooid' => {
__PACKAGE__->set_primary_key('fooid');
- __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar$main::suffix' => 'bar');
+ __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar${suffix}' => 'bar');
__PACKAGE__->many_to_many( foos => foo_to_bar => 'bar' );
-
}
{
package #
- DBICTest::Schema::FooToBar$suffix;
+ DBICTest::Schema::FooToBar${suffix};
use base 'DBIx::Class::Core';
__PACKAGE__->table('foo_to_bar');
data_type => 'integer',
},
);
- __PACKAGE__->belongs_to('foo' => 'DBICTest::Schema::Foo$main::suffix');
- __PACKAGE__->belongs_to('bar' => 'DBICTest::Schema::Foo$main::suffix');
+ __PACKAGE__->belongs_to('foo' => 'DBICTest::Schema::Foo${suffix}');
+ __PACKAGE__->belongs_to('bar' => 'DBICTest::Schema::Foo${suffix}');
}
{
package #
- DBICTest::Schema::Bar$suffix;
+ DBICTest::Schema::Bar${suffix};
+
use base 'DBIx::Class::Core';
+
__PACKAGE__->table('bar');
__PACKAGE__->add_columns(
'barid' => {
},
);
- use DBIx::Class::Relationship::ManyToMany;
- $main::no_warn
__PACKAGE__->set_primary_key('barid');
- __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar$main::suffix' => 'foo');
+ __PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar${suffix}' => 'foo');
+
__PACKAGE__->many_to_many( bars => foo_to_bar => 'foo' );
sub add_to_bars {}
- die $main::suffix;
}
EOF
- return $file;
+
}