test float(x) type aliases in pg
[dbsrgits/DBIx-Class-Schema-Loader.git] / t / lib / dbixcsl_common_tests.pm
index 97de888..8dff6ec 100644 (file)
@@ -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 {
@@ -60,29 +65,6 @@ sub _monikerize {
     return undef;
 }
 
-sub _custom_column_info {
-    my ( $table_name, $column_name, $column_info ) = @_;
-
-    $table_name = lc ( $table_name );
-    $column_name = lc ( $column_name );
-
-    if ( $table_name eq 'loader_test35' 
-        and $column_name eq 'an_int' 
-    ){
-        return { is_numeric => 1 }
-    }
-    # Set inflate_datetime or  inflate_date to check 
-    #   datetime_timezone and datetime_locale
-    if ( $table_name eq 'loader_test36' ){
-        return { inflate_datetime => 1 } if 
-            ( $column_name eq 'b_char_as_data' );
-        return { inflate_date => 1 } if 
-            ( $column_name eq 'c_char_as_data' );
-    }
-
-    return;
-}
-
 sub run_tests {
     my $self = shift;
 
@@ -97,7 +79,7 @@ sub run_tests {
         }
     }
 
-    plan tests => @connect_info * (159 + ($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];
@@ -153,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 @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 $@;
 
-       my $vendor = $self->{vendor};
-       $warn_count++ for grep /${vendor}_\S+ has no primary key/,
-           @loader_warnings;
+        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: {
@@ -392,7 +372,7 @@ sub test_schema {
     );
 
     SKIP: {
-        skip $self->{skip_rels}, 101 if $self->{skip_rels};
+        skip $self->{skip_rels}, 116 if $self->{skip_rels};
 
         my $moniker3 = $monikers->{loader_test3};
         my $class3   = $classes->{loader_test3};
@@ -532,6 +512,52 @@ sub test_schema {
         ok ($rsobj4->result_source->has_relationship('loader_test5s_from'),
             "rel with preposition 'from' pluralized correctly");
 
+        # check default relationship attributes
+        is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_delete}, 0,
+            'cascade_delete => 0 on has_many by default';
+
+        is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_copy}, 0,
+            'cascade_copy => 0 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');
+
+        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');
+
+        ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_copy}),
+            'belongs_to does not have cascade_copy');
+
+        is $rsobj27->result_source->relationship_info('loader_test28')->{attrs}{cascade_delete}, 0,
+            'cascade_delete => 0 on might_have by default';
+
+        is $rsobj27->result_source->relationship_info('loader_test28')->{attrs}{cascade_copy}, 0,
+            'cascade_copy => 0 on might_have by default';
+
+        ok ((not exists $rsobj27->result_source->relationship_info('loader_test28')->{attrs}{on_delete}),
+            'might_have does not have on_delete');
+
+        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}) } ||
@@ -837,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};
 
@@ -1319,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...
@@ -1440,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
@@ -1448,6 +1505,71 @@ sub drop_tables {
     $dbh->disconnect;
 }
 
+sub _custom_column_info {
+    my ( $table_name, $column_name, $column_info ) = @_;
+
+    $table_name = lc ( $table_name );
+    $column_name = lc ( $column_name );
+
+    if ( $table_name eq 'loader_test35' 
+        and $column_name eq 'an_int' 
+    ){
+        return { is_numeric => 1 }
+    }
+    # Set inflate_datetime or  inflate_date to check 
+    #   datetime_timezone and datetime_locale
+    if ( $table_name eq 'loader_test36' ){
+        return { inflate_datetime => 1 } if 
+            ( $column_name eq 'b_char_as_data' );
+        return { inflate_date => 1 } if 
+            ( $column_name eq 'c_char_as_data' );
+    }
+
+    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;
+
+    my %seen_col_names;
+
+    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' : '');
+
+        $col_name .= $seen_col_names{$col_name} if $seen_col_names{$col_name}++;
+
+        $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}) {