X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2Fdbixcsl_common_tests.pm;h=155a12a990efe9341e89fdb8c3fd7cc4641e96fb;hb=deedd5761dc499f7a9121734cd6a02eb8991c93f;hp=d8dc3f58b07732e55d5b8e1c64fd1884a996ef1c;hpb=53ef681d0209e2c85ddd60e049e3c8510fb27bb5;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index d8dc3f5..155a12a 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -11,6 +11,7 @@ use DBI;
 use Digest::MD5;
 use File::Find 'find';
 use Class::Unload ();
+use Data::Dumper::Concise;
 
 my $DUMP_DIR = './t/_common_dump';
 rmtree $DUMP_DIR;
@@ -45,7 +46,11 @@ sub new {
     $self->{default_function} ||= "CURRENT_TIMESTAMP";
     $self->{default_function_def} ||= "TIMESTAMP DEFAULT $self->{default_function}";
 
-    return bless $self => $class;
+    $self = bless $self, $class;
+
+    $self->setup_data_type_tests;
+
+    return $self;
 }
 
 sub skip_tests {
@@ -74,7 +79,7 @@ sub run_tests {
         }
     }
 
-    plan tests => @connect_info * (171 + ($self->{extra}->{count} || 0));
+    plan tests => @connect_info * (174 + ($self->{extra}{count} || 0) + ($self->{data_type_tests}{test_count} || 0));
 
     foreach my $info_idx (0..$#connect_info) {
         my $info = $connect_info[$info_idx];
@@ -130,46 +135,44 @@ sub setup_schema {
     Class::Unload->unload($schema_class);
 
     my $file_count;
-    my $expected_count = 36;
+    my $expected_count = 36 + ($self->{data_type_tests}{test_count} ? 1 : 0);
     {
-       my @loader_warnings;
-       local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
-        eval qq{
-            package $schema_class;
-            use base qw/DBIx::Class::Schema::Loader/;
-    
-            __PACKAGE__->loader_options(\%loader_opts);
-            __PACKAGE__->connection(\@connect_info);
-        };
-
-       ok(!$@, "Loader initialization") or diag $@;
-
-       find sub { return if -d; $file_count++ }, $DUMP_DIR;
-
-       $expected_count += grep /CREATE (?:TABLE|VIEW)/i,
-           @{ $self->{extra}{create} || [] };
-
-       $expected_count -= grep /CREATE TABLE/, @statements_inline_rels
-           if $self->{skip_rels} || $self->{no_inline_rels};
-
-       $expected_count -= grep /CREATE TABLE/, @statements_implicit_rels
-           if $self->{skip_rels} || $self->{no_implicit_rels};
-
-       $expected_count -= grep /CREATE TABLE/, ($self->{vendor} =~ /sqlite/ ? @statements_advanced_sqlite : @statements_advanced), @statements_reltests
-           if $self->{skip_rels};
-
-       is $file_count, $expected_count, 'correct number of files generated';
-
-       my $warn_count = 2;
-       $warn_count++ if grep /ResultSetManager/, @loader_warnings;
-
-       $warn_count++ for grep /^Bad table or view/, @loader_warnings;
-
-       $warn_count++ for grep /renaming \S+ relation/, @loader_warnings;
-
-       my $vendor = $self->{vendor};
-       $warn_count++ for grep /${vendor}_\S+ has no primary key/,
-           @loader_warnings;
+        my @loader_warnings;
+        local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
+         eval qq{
+             package $schema_class;
+             use base qw/DBIx::Class::Schema::Loader/;
+     
+             __PACKAGE__->loader_options(\%loader_opts);
+             __PACKAGE__->connection(\@connect_info);
+         };
+ 
+        ok(!$@, "Loader initialization") or diag $@;
+ 
+        find sub { return if -d; $file_count++ }, $DUMP_DIR;
+ 
+        $expected_count += grep /CREATE (?:TABLE|VIEW)/i,
+            @{ $self->{extra}{create} || [] };
+ 
+        $expected_count -= grep /CREATE TABLE/, @statements_inline_rels
+            if $self->{skip_rels} || $self->{no_inline_rels};
+ 
+        $expected_count -= grep /CREATE TABLE/, @statements_implicit_rels
+            if $self->{skip_rels} || $self->{no_implicit_rels};
+ 
+        $expected_count -= grep /CREATE TABLE/, ($self->{vendor} =~ /sqlite/ ? @statements_advanced_sqlite : @statements_advanced), @statements_reltests
+            if $self->{skip_rels};
+ 
+        is $file_count, $expected_count, 'correct number of files generated';
+ 
+        my $warn_count = 2;
+        $warn_count++ if grep /ResultSetManager/, @loader_warnings;
+ 
+        $warn_count++ for grep /^Bad table or view/, @loader_warnings;
+ 
+        $warn_count++ for grep /renaming \S+ relation/, @loader_warnings;
+ 
+        $warn_count++ for grep /\b(?!loader_test9)\w+ has no primary key/i, @loader_warnings;
 
         if($self->{skip_rels}) {
             SKIP: {
@@ -369,7 +372,7 @@ sub test_schema {
     );
 
     SKIP: {
-        skip $self->{skip_rels}, 113 if $self->{skip_rels};
+        skip $self->{skip_rels}, 116 if $self->{skip_rels};
 
         my $moniker3 = $monikers->{loader_test3};
         my $class3   = $classes->{loader_test3};
@@ -522,12 +525,18 @@ sub test_schema {
         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');
+
         is $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_delete}, 'CASCADE',
             "on_delete => 'CASCADE' on belongs_to by default";
 
         is $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_update}, 'CASCADE',
             "on_update => 'CASCADE' on belongs_to by default";
 
+        is $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{is_deferrable}, 1,
+            "is_deferrable => 1 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');
 
@@ -546,6 +555,9 @@ sub test_schema {
         ok ((not exists $rsobj27->result_source->relationship_info('loader_test28')->{attrs}{on_update}),
             'might_have does not have on_update');
 
+        ok ((not exists $rsobj27->result_source->relationship_info('loader_test28')->{attrs}{is_deferrable}),
+            'might_have does not have is_deferrable');
+
         # find on multi-col pk
         my $obj5 = 
 	    eval { $rsobj5->find({id1 => 1, iD2 => 1}) } ||
@@ -851,7 +863,30 @@ sub test_schema {
            'Foreign key detected');
     }
 
-    $self->{extra}->{run}->($conn, $monikers, $classes) if $self->{extra}->{run};
+    # test data types
+    if ($self->{data_type_tests}{test_count}) {
+        my $data_type_tests = $self->{data_type_tests};
+        my $columns = $data_type_tests->{columns};
+
+        my $rsrc = $conn->resultset($data_type_tests->{table_moniker})->result_source;
+
+        while (my ($col_name, $expected_info) = each %$columns) {
+            while (my ($info_key, $info_val) = each %$expected_info) {
+                my $text_info_val = do {
+                    my $dd = Dumper;
+                    $dd->Indent(0);
+                    $dd->Values([$info_val]);
+                    $dd->Dump;
+                };
+
+                is_deeply $rsrc->column_info($col_name)->{$info_key}, $info_val,
+                    "column of type $col_name has $info_key => $text_info_val";
+            }
+        }
+    }
+
+    # run extra tests
+    $self->{extra}{run}->($conn, $monikers, $classes) if $self->{extra}{run};
 
     $self->drop_tables unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
 
@@ -1333,6 +1368,9 @@ sub create {
     };
 
     $dbh->do($_) for (@statements);
+
+    $dbh->do($self->{data_type_tests}{ddl}) if $self->{data_type_tests}{ddl};
+
     unless($self->{skip_rels}) {
         # hack for now, since DB2 doesn't like inline comments, and we need
         # to test one for mysql, which works on everyone else...
@@ -1454,6 +1492,11 @@ sub drop_tables {
     }
     $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc;
     $dbh->do("DROP TABLE $_") for (@tables, @tables_rescan);
+
+    if (my $data_type_table = $self->{data_type_tests}{table_name}) {
+        $dbh->do("DROP TABLE $data_type_table");
+    }
+
     $dbh->disconnect;
 
 # fixup for Firebird
@@ -1485,6 +1528,44 @@ sub _custom_column_info {
     return;
 }
 
+sub setup_data_type_tests {
+    my $self = shift;
+
+    return unless my $types = $self->{data_types};
+
+    my $tests = $self->{data_type_tests} = {};
+    my $cols  = $tests->{columns}        = {};
+
+    $tests->{table_name}    = 'loader_test9999';
+    $tests->{table_moniker} = 'LoaderTest9999';
+
+    my $ddl = "CREATE TABLE loader_test9999 (\n    id INTEGER NOT NULL PRIMARY KEY,\n";
+
+    my $test_count = 0;
+
+    while (my ($col_def, $expected_info) = each %$types) {
+        my $have_size = $col_def =~ /\(/ ? 1 : 0;
+
+        (my $type_alias = $col_def) =~ s/\([^()]+\)//g;
+        $type_alias =~ s/\s/_/g;
+
+        my $col_name = $type_alias . ($have_size ? '_with_size' : '');
+
+        $ddl .= "    $col_name $col_def,\n";
+
+        $cols->{$col_name} = $expected_info;
+
+        $test_count += scalar keys %$expected_info;
+    }
+
+    $ddl =~ s/,\n\z/\n)/;
+
+    $tests->{ddl}        = $ddl;
+    $tests->{test_count} = $test_count;
+
+    return $test_count;
+}
+
 sub DESTROY {
     my $self = shift;
     unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {