[Bast-commits] r5254 - in DBIx-Class/0.08/trunk: lib/DBIx/Class/Relationship t

ribasushi at dev.catalyst.perl.org ribasushi at dev.catalyst.perl.org
Thu Dec 18 11:28:39 GMT 2008


Author: ribasushi
Date: 2008-12-18 11:28:38 +0000 (Thu, 18 Dec 2008)
New Revision: 5254

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/ManyToMany.pm
   DBIx-Class/0.08/trunk/t/103many_to_many_warning.t
Log:
Some cleanups to the m2m warnings test

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/ManyToMany.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/ManyToMany.pm	2008-12-17 18:40:43 UTC (rev 5253)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Relationship/ManyToMany.pm	2008-12-18 11:28:38 UTC (rev 5254)
@@ -27,18 +27,21 @@
     my $rs_meth = "${meth}_rs";
 
     for ($add_meth, $remove_meth, $set_meth, $rs_meth) {
-      warnings::warn(<<"EOW")
+      if ( $class->can ($_) ) {
+        warnings::warnif(<<"EOW")
 ***************************************************************************
 The many-to-many relationship $meth is trying to create a utility method called
 $_. This will overwrite the existing method on $class. You almost certainly
 want to rename your method or the many-to-many relationship, as your method
-will not be callable (it will use the one from the relationship instead.) 
+will not be callable (it will use the one from the relationship instead.)
 
-no warnings 'DBIx::Class::Relationship::ManyToMany'; in 
-$class to disable.
+To disable this warning add the following to $class
+
+  no warnings 'DBIx::Class::Relationship::ManyToMany';
+
 ***************************************************************************
 EOW
-        if warnings::enabled() && $class->can($_);
+      }
     }
 
     $rel_attrs->{alias} ||= $f_rel;

Modified: DBIx-Class/0.08/trunk/t/103many_to_many_warning.t
===================================================================
--- DBIx-Class/0.08/trunk/t/103many_to_many_warning.t	2008-12-17 18:40:43 UTC (rev 5253)
+++ DBIx-Class/0.08/trunk/t/103many_to_many_warning.t	2008-12-18 11:28:38 UTC (rev 5254)
@@ -3,38 +3,48 @@
 use Test::More;
 
 use lib qw(t/lib);
+use Data::Dumper;
 
+plan tests => 2;
 
-our $no_warn = "";
-our $suffix = "";
+{
+  my @w; 
+  local $SIG{__WARN__} = sub { push @w, @_ };
 
-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 $code = gen_code ( suffix => 1 );
+  eval "$code";
+
+  ok ( (grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "Warning triggered without relevant 'no warnings'");
 }
 
 {
+  my @w; 
+  local $SIG{__WARN__} = sub { push @w, @_ };
 
-  $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'");
+  my $code = gen_code ( suffix => 2, no_warn => 1 );
+  eval "$code";
+
+diag Dumper \@w;
+
+  ok ( (not grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "No warning triggered with relevant 'no warnings'");
 }
 
-sub code {
-my $file = << "EOF";
+sub gen_code {
+
+  my $args = { @_ };
+  my $suffix = $args->{suffix};
+  my $no_warn = ( $args->{no_warn}
+    ? "no warnings 'DBIx::Class::Relationship::ManyToMany';"
+    : '',
+  );
+
+  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(
@@ -46,13 +56,12 @@
   __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');
@@ -64,12 +73,13 @@
       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(
@@ -79,15 +89,14 @@
     },
   );
 
-  use DBIx::Class::Relationship::ManyToMany;
-  $main::no_warn
+  ${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;
+
 }




More information about the Bast-commits mailing list