X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2Fdbixcsl_common_tests.pm;h=bcd59446e1317bd4a1679cbfdb999f363b20efb7;hb=3fea497fec40754dfbe468328ab1319fc9403856;hp=af826f240d4d33c38af71fee53296589fb2432ec;hpb=b48f3f80f2201bb0921330b1a8d7800d11900e78;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index af826f2..bcd5944 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -15,6 +15,7 @@ use Class::Unload ();
 use DBIx::Class::Schema::Loader::Utils 'dumper_squashed';
 use List::MoreUtils 'apply';
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
+use Try::Tiny;
 use namespace::clean;
 
 use dbixcsl_test_dir qw/$tdir/;
@@ -94,13 +95,14 @@ sub run_tests {
 
     my $extra_count = $self->{extra}{count} || 0;
 
-    my $column_accessor_map_tests = 5;
+    my $col_accessor_map_tests = 5;
     my $num_rescans = 5;
     $num_rescans-- if $self->{vendor} =~ /^(?:sybase|mysql)\z/i;
     $num_rescans++ if $self->{vendor} eq 'mssql';
+    $num_rescans++ if $self->{vendor} eq 'Firebird';
 
     plan tests => @connect_info *
-        (182 + $num_rescans * $column_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+        (188 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
 
     foreach my $info_idx (0..$#connect_info) {
         my $info = $connect_info[$info_idx];
@@ -206,8 +208,8 @@ sub setup_schema {
         additional_classes      => 'TestAdditional',
         additional_base_classes => 'TestAdditionalBase',
         left_base_classes       => [ qw/TestLeftBase/ ],
-        components              => [ qw/TestComponent/ ],
-        inflect_plural          => { loader_test4 => 'loader_test4zes' },
+        components              => [ qw/TestComponent +TestComponentFQN/ ],
+        inflect_plural          => { loader_test4_fkid => 'loader_test4zes' },
         inflect_singular        => { fkid => 'fkid_singular' },
         moniker_map             => \&_monikerize,
         custom_column_info      => \&_custom_column_info,
@@ -218,7 +220,8 @@ sub setup_schema {
         datetime_locale         => 'de_DE',
         use_moose               => $ENV{SCHEMA_LOADER_TESTS_USE_MOOSE},
         col_collision_map       => { '^(can)\z' => 'caught_collision_%s' },
-        column_accessor_map     => \&test_column_accessor_map,
+        rel_collision_map       => { '^(set_primary_key)\z' => 'caught_rel_collision_%s' },
+        col_accessor_map        => \&test_col_accessor_map,
         %{ $self->{loader_options} || {} },
     );
 
@@ -274,10 +277,14 @@ sub setup_schema {
  
         $warn_count++ for grep /\b(?!loader_test9)\w+ has no primary key/i, @loader_warnings;
 
-        $warn_count++ for grep /^Column \w+ in table \w+ collides with an inherited method\./, @loader_warnings;
+        $warn_count++ for grep /^Column '\w+' in table '\w+' collides with an inherited method\./, @loader_warnings;
+
+        $warn_count++ for grep /^Relationship '\w+' in source '\w+' for columns '[^']+' collides with an inherited method\./, @loader_warnings;
 
         $warn_count++ for grep { my $w = $_; grep $w =~ $_, @{ $self->{warnings} || [] } } @loader_warnings;
 
+        $warn_count-- for grep { my $w = $_; grep $w =~ $_, @{ $self->{failtrigger_warnings} || [] } } @loader_warnings;
+
         if ($standard_sources) {
             if($self->{skip_rels}) {
                 SKIP: {
@@ -347,7 +354,7 @@ sub test_schema {
     isa_ok( $rsobj35, "DBIx::Class::ResultSet" );
 
     my @columns_lt2 = $class2->columns;
-    is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent meta/ ], "Column Ordering" );
+    is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent testcomponent_fqn meta/ ], "Column Ordering" );
 
     is $class2->column_info('can')->{accessor}, 'caught_collision_can',
         'accessor for column name that conflicts with a UNIVERSAL method renamed based on col_collision_map';
@@ -358,6 +365,9 @@ sub test_schema {
     is $class2->column_info('dbix_class_testcomponent')->{accessor}, undef,
         'accessor for column name that conflicts with a component class method removed';
 
+    is $class2->column_info('testcomponent_fqn')->{accessor}, undef,
+        'accessor for column name that conflicts with a fully qualified component class method removed';
+
     is $class2->column_info('meta')->{accessor}, undef,
         'accessor for column name that conflicts with Moose removed';
 
@@ -419,6 +429,9 @@ sub test_schema {
             'Additional Component' );
     }
 
+    is ((try { $class1->testcomponent_fqn }), 'TestComponentFQN works',
+        'fully qualified component class');
+
     SKIP: {
         can_ok( $class1, 'loader_test1_classmeth' )
             or skip "Pre-requisite test failed", 1;
@@ -480,7 +493,7 @@ sub test_schema {
     );
 
     SKIP: {
-        skip $self->{skip_rels}, 116 if $self->{skip_rels};
+        skip $self->{skip_rels}, 120 if $self->{skip_rels};
 
         my $moniker3 = $monikers->{loader_test3};
         my $class3   = $classes->{loader_test3};
@@ -607,6 +620,14 @@ sub test_schema {
         my $obj4 = $rsobj4->find(123);
         isa_ok( $obj4->fkid_singular, $class3);
 
+        # test renaming rel that conflicts with a class method
+        ok ($obj4->has_relationship('belongs_to_rel'), 'relationship name that conflicts with a method renamed');
+        isa_ok( $obj4->belongs_to_rel, $class3);
+
+        ok ($obj4->has_relationship('caught_rel_collision_set_primary_key'),
+            'relationship name that conflicts with a method renamed based on rel_collision_map');
+        isa_ok( $obj4->caught_rel_collision_set_primary_key, $class3);
+
         ok($class4->column_info('fkid')->{is_foreign_key}, 'Foreign key detected');
 
         my $obj3 = $rsobj3->find(1);
@@ -614,7 +635,7 @@ sub test_schema {
         isa_ok( $rs_rel4->first, $class4);
 
         is( $class4->column_info('crumb_crisp_coating')->{accessor},  'trivet',
-            'column_accessor_map is being run' );
+            'col_accessor_map is being run' );
 
         # check rel naming with prepositions
         ok ($rsobj4->result_source->has_relationship('loader_test5s_to'),
@@ -1197,6 +1218,7 @@ sub create {
                 set_primary_key INTEGER $self->{null},
                 can INTEGER $self->{null},
                 dbix_class_testcomponent INTEGER $self->{null},
+                testcomponent_fqn INTEGER $self->{null},
                 meta INTEGER $self->{null},
                 UNIQUE (dat2, dat)
             ) $self->{innodb}
@@ -1266,14 +1288,18 @@ sub create {
                 fkid INTEGER NOT NULL,
                 dat VARCHAR(32),
                 crumb_crisp_coating VARCHAR(32) $self->{null},
-                FOREIGN KEY( fkid ) REFERENCES loader_test3 (id)
+                belongs_to INTEGER $self->{null},
+                set_primary_key INTEGER $self->{null},
+                FOREIGN KEY( fkid ) REFERENCES loader_test3 (id),
+                FOREIGN KEY( belongs_to ) REFERENCES loader_test3 (id),
+                FOREIGN KEY( set_primary_key ) REFERENCES loader_test3 (id)
             ) $self->{innodb}
         },
 
-        q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa') },
-        q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb') }, 
-        q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc') },
-        q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd') },
+        q{ INSERT INTO loader_test4 (id,fkid,dat,belongs_to,set_primary_key) VALUES(123,1,'aaa',1,1) },
+        q{ INSERT INTO loader_test4 (id,fkid,dat,belongs_to,set_primary_key) VALUES(124,2,'bbb',2,2) }, 
+        q{ INSERT INTO loader_test4 (id,fkid,dat,belongs_to,set_primary_key) VALUES(125,3,'ccc',3,3) },
+        q{ INSERT INTO loader_test4 (id,fkid,dat,belongs_to,set_primary_key) VALUES(126,4,'ddd',4,4) },
 
         qq|
             CREATE TABLE loader_test5 (
@@ -1891,12 +1917,12 @@ sub rescan_without_warnings {
     return $conn->rescan;
 }
 
-sub test_column_accessor_map {
+sub test_col_accessor_map {
     my ( $column_name, $default_name, $context ) = @_;
     if( lc($column_name) eq 'crumb_crisp_coating' ) {
 
-        is( $default_name, 'crumb_crisp_coating', 'column_accessor_map was passed the default name' );
-        ok( $context->{$_}, "column_accessor_map func was passed the $_" )
+        is( $default_name, 'crumb_crisp_coating', 'col_accessor_map was passed the default name' );
+        ok( $context->{$_}, "col_accessor_map func was passed the $_" )
             for qw( table_name table_class table_moniker schema_class );
 
         return 'trivet';