Add author test for whitespace errors and make whitespace more consistent
[dbsrgits/DBIx-Class-Schema-Loader.git] / t / backcompat / 0.04006 / lib / dbixcsl_common_tests.pm
index e4e2517..2ffba52 100644 (file)
@@ -22,7 +22,7 @@ sub new {
 
     # Only MySQL uses this
     $self->{innodb} ||= '';
-    
+
     $self->{verbose} = $ENV{TEST_VERBOSE} || 0;
 
     return bless $self => $class;
@@ -43,7 +43,7 @@ sub _monikerize {
 sub run_tests {
     my $self = shift;
 
-    plan tests => 88;
+    plan tests => 97;
 
     $self->create();
 
@@ -66,13 +66,6 @@ sub run_tests {
     );
 
     $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema};
-    eval { require Class::Inspector };
-    if($@) {
-        $self->{_no_rs_components} = 1;
-    }
-    else {
-        $loader_opts{resultset_components} = [ qw/TestRSComponent/ ];
-    }
 
     {
        my @loader_warnings;
@@ -80,7 +73,7 @@ sub run_tests {
         eval qq{
             package $schema_class;
             use base qw/DBIx::Class::Schema::Loader/;
-    
+
             __PACKAGE__->loader_options(\%loader_opts);
             __PACKAGE__->connection(\@connect_info);
         };
@@ -88,29 +81,28 @@ sub run_tests {
 
         my $warn_count = 0;
         $warn_count++ if grep /ResultSetManager/, @loader_warnings;
+        $warn_count++ if grep /Dynamic schema detected/, @loader_warnings;
+        $warn_count++ for grep /^Bad table or view/, @loader_warnings;
 
-        if($self->{skip_rels}) {
-            is(scalar(@loader_warnings), $warn_count)
-              or diag "Did not get the expected 0 warnings.  Warnings are: "
-                . join('',@loader_warnings);
-            ok(1);
-        }
-        else {
-            $warn_count++;
-            is(scalar(@loader_warnings), $warn_count)
-              or diag "Did not get the expected 1 warning.  Warnings are: "
-                . join('',@loader_warnings);
-            is(grep(/loader_test9 has no primary key/, @loader_warnings), 1);
-        }
+        is(scalar(@loader_warnings), $warn_count)
+          or diag "Did not get the expected 0 warnings.  Warnings are: "
+            . join('',@loader_warnings);
     }
 
     my $conn = $schema_class->clone;
     my $monikers = {};
     my $classes = {};
     foreach my $source_name ($schema_class->sources) {
-        my $table_name = $schema_class->source($source_name)->from;
+        my $table_name = $schema_class->loader->moniker_to_table->{$source_name};
+
+        my $result_class = $schema_class->source($source_name)->result_class;
+
         $monikers->{$table_name} = $source_name;
-        $classes->{$table_name} = $schema_class . q{::} . $source_name;
+        $classes->{$table_name} = $result_class;
+
+        # some DBs (Firebird, Oracle) uppercase everything
+        $monikers->{lc $table_name} = $source_name;
+        $classes->{lc $table_name} = $result_class;
     }
 
 # for debugging...
@@ -174,7 +166,7 @@ sub run_tests {
 
     {
         my ($skip_tab, $skip_tabo, $skip_taba, $skip_cmeth,
-            $skip_rsmeth, $skip_tcomp, $skip_trscomp);
+            $skip_tcomp, $skip_trscomp);
 
         can_ok( $class1, 'test_additional_base' ) or $skip_tab = 1;
         can_ok( $class1, 'test_additional_base_override' ) or $skip_tabo = 1;
@@ -182,11 +174,6 @@ sub run_tests {
         can_ok( $class1, 'dbix_class_testcomponent' ) or $skip_tcomp = 1;
         can_ok( $class1, 'loader_test1_classmeth' ) or $skip_cmeth = 1;
 
-        TODO: {
-            local $TODO = "Not yet supported by ResultSetManger code";
-            can_ok( $rsobj1, 'loader_test1_rsmeth' ) or $skip_rsmeth = 1;
-        }
-
         SKIP: {
             skip "Pre-requisite test failed", 1 if $skip_tab;
             is( $class1->test_additional_base, "test_additional_base",
@@ -213,26 +200,9 @@ sub run_tests {
         }
 
         SKIP: {
-            skip "These two tests need Class::Inspector installed", 2
-                     if $self->{_no_rs_components};
-            can_ok($rsobj1, 'dbix_class_testrscomponent') or $skip_trscomp = 1;
-            SKIP: {
-                skip "Pre-requisite test failed", 1 if $skip_trscomp;
-                is( $rsobj1->dbix_class_testrscomponent,
-                    'dbix_class_testrscomponent works' );
-            }
-        }
-
-        SKIP: {
             skip "Pre-requisite test failed", 1 if $skip_cmeth;
             is( $class1->loader_test1_classmeth, 'all is well' );
         }
-
-        # XXX put this back in when the TODO above works...
-        #SKIP: {
-        #    skip "Pre-requisite test failed", 1 if $skip_rsmeth;
-        #    is( $rsobj1->loader_test1_rsmeth, 'all is still well' );
-        #}
     }
 
 
@@ -256,7 +226,7 @@ sub run_tests {
     is( $obj2->id, 2 );
 
     SKIP: {
-        skip $self->{skip_rels}, 50 if $self->{skip_rels};
+        skip $self->{skip_rels}, 63 if $self->{skip_rels};
 
         my $moniker3 = $monikers->{loader_test3};
         my $class3   = $classes->{loader_test3};
@@ -347,6 +317,45 @@ sub run_tests {
         my $rs_rel4 = $obj3->search_related('loader_test4zes');
         isa_ok( $rs_rel4->first, $class4);
 
+        # test that _id is not stripped and prepositions in rel names are
+        # ignored
+        ok ($rsobj4->result_source->has_relationship('loader_test5_to_ids'),
+            "rel with preposition 'to' and _id pluralized backward-compatibly");
+
+        ok ($rsobj4->result_source->has_relationship('loader_test5_from_ids'),
+            "rel with preposition 'from' and _id pluralized backward-compatibly");
+
+        # check that default relationship attributes are not applied in 0.04006 mode
+        is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_delete}, 1,
+            'cascade_delete => 1 on has_many by default';
+
+        is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_copy}, 1,
+            'cascade_copy => 1 on has_many by default';
+
+        ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{on_delete}),
+            'has_many does not have on_delete');
+
+        ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{on_update}),
+            'has_many does not have on_update');
+
+        ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{is_deferrable}),
+            'has_many does not have is_deferrable');
+
+        isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_delete}, 'CASCADE',
+            "on_delete => 'CASCADE' not on belongs_to by default";
+
+        isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_update}, 'CASCADE',
+            "on_update => 'CASCADE' not on belongs_to by default";
+
+        isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{is_deferrable}, 1,
+            "is_deferrable => 1 not on belongs_to by default";
+
+        ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_delete}),
+            'belongs_to does not have cascade_delete');
+
+        ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_copy}),
+            'belongs_to does not have cascade_copy');
+
         # find on multi-col pk
         my $obj5 = $rsobj5->find({id1 => 1, id2 => 1});
         is( $obj5->id2, 1 );
@@ -375,9 +384,9 @@ sub run_tests {
         my $rs_rel17 = $obj16->search_related('loader_test17_loader16_ones');
         isa_ok($rs_rel17->first, $class17);
         is($rs_rel17->first->id, 3);
-        
+
         # XXX test m:m 18 <- 20 -> 19
-        
+
         # XXX test double-fk m:m 21 <- 22 -> 21
 
         # test double multi-col fk 26 -> 25
@@ -410,7 +419,7 @@ sub run_tests {
             my $class11   = $classes->{loader_test11};
             my $rsobj11   = $conn->resultset($moniker11);
 
-            isa_ok( $rsobj10, "DBIx::Class::ResultSet" ); 
+            isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
             isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
 
             my $obj10 = $rsobj10->create({ subject => 'xyzzy' });
@@ -427,12 +436,16 @@ sub run_tests {
                 $obj10_2->loader_test11( $obj11->id11() );
                 $obj10_2->update();
             };
-            is($@, '', 'No errors after eval{}');
+            is($@, '', 'No errors after eval{}')
+                or do {
+                    diag explain $rsobj10->result_source->relationship_info('loader_test11');
+                    diag explain $rsobj11->result_source->relationship_info('loader_test10');
+                };
 
             SKIP: {
                 skip 'Previous eval block failed', 3
                     unless ($@ eq '');
-        
+
                 my $results = $rsobj10->search({ subject => 'xyzzy' });
                 is( $results->count(), 1,
                     'One $rsobj10 returned from search' );
@@ -445,7 +458,7 @@ sub run_tests {
         }
 
         SKIP: {
-            skip 'This vendor cannot do inline relationship definitions', 5
+            skip 'This vendor cannot do inline relationship definitions', 6
                 if $self->{no_inline_rels};
 
             my $moniker12 = $monikers->{loader_test12};
@@ -456,13 +469,16 @@ sub run_tests {
             my $class13   = $classes->{loader_test13};
             my $rsobj13   = $conn->resultset($moniker13);
 
-            isa_ok( $rsobj12, "DBIx::Class::ResultSet" ); 
+            isa_ok( $rsobj12, "DBIx::Class::ResultSet" );
             isa_ok( $rsobj13, "DBIx::Class::ResultSet" );
 
             my $obj13 = $rsobj13->find(1);
             isa_ok( $obj13->id, $class12 );
             isa_ok( $obj13->loader_test12, $class12);
             isa_ok( $obj13->dat, $class12);
+
+            my $obj12 = $rsobj12->find(1);
+            isa_ok( $obj12->loader_test13_ids, "DBIx::Class::ResultSet" );
         }
 
         SKIP: {
@@ -476,7 +492,7 @@ sub run_tests {
             my $class15   = $classes->{loader_test15};
             my $rsobj15   = $conn->resultset($moniker15);
 
-            isa_ok( $rsobj14, "DBIx::Class::ResultSet" ); 
+            isa_ok( $rsobj14, "DBIx::Class::ResultSet" );
             isa_ok( $rsobj15, "DBIx::Class::ResultSet" );
 
             my $obj15 = $rsobj15->find(1);
@@ -500,11 +516,16 @@ sub run_tests {
             q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(321, 2) },
         );
 
-        my $dbh = $self->dbconnect(1);
-        $dbh->do($_) for @statements_rescan;
-        $dbh->disconnect;
+        {
+            my $dbh = $self->dbconnect(1);
+            $dbh->do($_) for @statements_rescan;
+            $dbh->disconnect;
+        }
 
-        my @new = $conn->rescan;
+        my @new = do {
+            local $SIG{__WARN__} = sub {};
+            $conn->rescan;
+        };
         is(scalar(@new), 1);
         is($new[0], 'LoaderTest30');
 
@@ -527,6 +548,12 @@ sub dbconnect {
              AutoCommit => 1,
          }
     );
+    if ($self->{dsn} =~ /^[^:]+:SQLite:/) {
+      $dbh->do ('PRAGMA synchronous = OFF');
+    }
+    elsif ($self->{dsn} =~ /^[^:]+:Pg:/) {
+      $dbh->do ('SET client_min_messages=WARNING');
+    }
 
     die "Failed to connect to database: $DBI::errstr" if !$dbh;
 
@@ -549,10 +576,10 @@ sub create {
         $make_auto_inc->(qw/loader_test1 id/),
 
         q{ INSERT INTO loader_test1 (dat) VALUES('foo') },
-        q{ INSERT INTO loader_test1 (dat) VALUES('bar') }, 
-        q{ INSERT INTO loader_test1 (dat) VALUES('baz') }, 
+        q{ INSERT INTO loader_test1 (dat) VALUES('bar') },
+        q{ INSERT INTO loader_test1 (dat) VALUES('baz') },
 
-        qq{ 
+        qq{
             CREATE TABLE loader_test2 (
                 id $self->{auto_inc_pk},
                 dat VARCHAR(32) NOT NULL,
@@ -562,10 +589,10 @@ sub create {
         },
         $make_auto_inc->(qw/loader_test2 id/),
 
-        q{ INSERT INTO loader_test2 (dat, dat2) VALUES('aaa', 'zzz') }, 
-        q{ INSERT INTO loader_test2 (dat, dat2) VALUES('bbb', 'yyy') }, 
-        q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ccc', 'xxx') }, 
-        q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ddd', 'www') }, 
+        q{ INSERT INTO loader_test2 (dat, dat2) VALUES('aaa', 'zzz') },
+        q{ INSERT INTO loader_test2 (dat, dat2) VALUES('bbb', 'yyy') },
+        q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ccc', 'xxx') },
+        q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ddd', 'www') },
 
         qq{
             CREATE TABLE LOADER_TEST23 (
@@ -590,10 +617,10 @@ sub create {
             ) $self->{innodb}
         },
 
-        q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa') }, 
-        q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb') }, 
-        q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc') }, 
-        q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd') }, 
+        q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa') },
+        q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb') },
+        q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc') },
+        q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd') },
 
         qq{
             CREATE TABLE loader_test4 (
@@ -605,7 +632,7 @@ sub create {
         },
 
         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(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') },
 
@@ -614,7 +641,11 @@ sub create {
                 id1 INTEGER NOT NULL,
                 iD2 INTEGER NOT NULL,
                 dat VARCHAR(8),
-                PRIMARY KEY (id1,id2)
+                from_id INTEGER,
+                to_id INTEGER,
+                PRIMARY KEY (id1,id2),
+                FOREIGN KEY (from_id) REFERENCES loader_test4 (id),
+                FOREIGN KEY (to_id) REFERENCES loader_test4 (id)
             ) $self->{innodb}
         },
 
@@ -748,7 +779,7 @@ sub create {
         q{ INSERT INTO loader_test22 (parent, child) VALUES (11,13)},
         q{ INSERT INTO loader_test22 (parent, child) VALUES (13,17)},
 
-       qq{
+        qq{
             CREATE TABLE loader_test25 (
                 id1 INTEGER NOT NULL,
                 id2 INTEGER NOT NULL,
@@ -831,7 +862,7 @@ sub create {
                 dat VARCHAR(8)
             ) $self->{innodb}
         },
+
         q{ INSERT INTO loader_test14 (id,dat) VALUES (123,'aaa') },
 
         qq{
@@ -849,12 +880,6 @@ sub create {
 
     my $dbh = $self->dbconnect(1);
 
-    # Silence annoying but harmless postgres "NOTICE:  CREATE TABLE..."
-    local $SIG{__WARN__} = sub {
-        my $msg = shift;
-        print STDERR $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
-    };
-
     $dbh->do($_) for (@statements);
     unless($self->{skip_rels}) {
         # hack for now, since DB2 doesn't like inline comments, and we need
@@ -883,7 +908,7 @@ sub drop_tables {
         LOADER_TEST23
         LoAdEr_test24
     /;
-    
+
     my @tables_auto_inc = (
         [ qw/loader_test1 id/ ],
         [ qw/loader_test2 id/ ],
@@ -912,7 +937,7 @@ sub drop_tables {
         loader_test11
         loader_test10
     /;
-    
+
     my @tables_advanced_auto_inc = (
         [ qw/loader_test10 id10/ ],
         [ qw/loader_test11 id11/ ],