more work on multi-db_schema
[dbsrgits/DBIx-Class-Schema-Loader.git] / t / lib / dbixcsl_common_tests.pm
index e3df577..9067be9 100644 (file)
@@ -120,7 +120,7 @@ sub run_tests {
     $num_rescans++ if $self->{vendor} eq 'Firebird';
 
     plan tests => @connect_info *
-        (206 + ($self->{skip_rels} ? 5 : $num_rescans * $col_accessor_map_tests) + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+        (209 + $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];
@@ -140,7 +140,7 @@ sub run_tests {
 sub run_only_extra_tests {
     my ($self, $connect_info) = @_;
 
-    plan tests => @$connect_info * (4 + ($self->{extra}{count} || 0) + ($self->{data_type_tests}{test_count} || 0));
+    plan tests => @$connect_info * (3 + ($self->{extra}{count} || 0) + ($self->{data_type_tests}{test_count} || 0));
 
     rmtree DUMP_DIR;
 
@@ -156,7 +156,14 @@ sub run_only_extra_tests {
         $dbh->do($_) for @{ $self->{extra}{create} || [] };
 
         if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) {
-            $dbh->do($_) for @{ $self->{data_type_tests}{ddl} || []};
+            foreach my $ddl (@{ $self->{data_type_tests}{ddl} || []}) {
+                if (my $cb = $self->{data_types_ddl_cb}) {
+                    $cb->($ddl);
+                }
+                else {
+                    $dbh->do($ddl);
+                }
+            }
         }
 
         $self->{_created} = 1;
@@ -244,6 +251,7 @@ sub setup_schema {
         rel_collision_map       => { '^(set_primary_key)\z' => 'caught_rel_collision_%s' },
         col_accessor_map        => \&test_col_accessor_map,
         result_components_map   => { LoaderTest2X => 'TestComponentForMap', LoaderTest1 => '+TestComponentForMapFQN' },
+        uniq_to_primary         => 1,
         %{ $self->{loader_options} || {} },
     );
 
@@ -270,7 +278,7 @@ sub setup_schema {
         my $standard_sources = not defined $expected_count;
 
         if ($standard_sources) {
-            $expected_count = 36;
+            $expected_count = 37;
 
             if (not ($self->{vendor} eq 'mssql' && $connect_info->[0] =~ /Sybase/)) {
                 $expected_count++ for @{ $self->{data_type_tests}{table_names} || [] };
@@ -307,29 +315,8 @@ sub setup_schema {
 
         $warn_count-- for grep { my $w = $_; grep $w =~ $_, @{ $self->{failtrigger_warnings} || [] } } @loader_warnings;
 
-        if ($standard_sources) {
-            if($self->{skip_rels}) {
-                SKIP: {
-                    is(scalar(@loader_warnings), $warn_count, "No loader warnings")
-                        or diag @loader_warnings;
-                    skip "No missing PK warnings without rels", 1;
-                }
-            }
-            else {
-                $warn_count++;
-                is(scalar(@loader_warnings), $warn_count, "Expected loader warnings")
-                    or diag @loader_warnings;
-                is(grep(/loader_test9 has no primary key/i, @loader_warnings), 1,
-                     "Missing PK warning");
-            }
-        }
-        else {
-            SKIP: {
-                is scalar(@loader_warnings), $warn_count, 'Correct number of warnings'
-                    or diag @loader_warnings;
-                skip "not testing standard sources", 1;
-            }
-        }
+        is scalar(@loader_warnings), $warn_count, 'Correct number of warnings'
+            or diag @loader_warnings;
     }
 
     exit if ($file_count||0) != $expected_count;
@@ -369,11 +356,16 @@ sub test_schema {
     my $class35   = $classes->{loader_test35};
     my $rsobj35   = $conn->resultset($moniker35);
 
+    my $moniker50 = $monikers->{loader_test50};
+    my $class50   = $classes->{loader_test50};
+    my $rsobj50   = $conn->resultset($moniker50);
+
     isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
     isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
     isa_ok( $rsobj23, "DBIx::Class::ResultSet" );
     isa_ok( $rsobj24, "DBIx::Class::ResultSet" );
     isa_ok( $rsobj35, "DBIx::Class::ResultSet" );
+    isa_ok( $rsobj50, "DBIx::Class::ResultSet" );
 
     # check result_namespace
     my @schema_dir = split /::/, SCHEMA_CLASS;
@@ -400,7 +392,7 @@ sub test_schema {
         'resultset_namespace set correctly on Schema';
 
     my @columns_lt2 = $class2->columns;
-    is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent dbix_class_testcomponentmap testcomponent_fqn meta test_role_method test_role_for_map_method/ ], "Column Ordering" );
+    is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent dbix_class_testcomponentmap testcomponent_fqn meta test_role_method test_role_for_map_method crumb_crisp_coating/ ], "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';
@@ -471,6 +463,11 @@ sub test_schema {
     }
     ok($uniq2_test, "Multi-col unique constraint");
 
+    my %uniq3 = $class50->unique_constraints;
+
+    is_deeply $uniq3{primary}, ['id1', 'id2'],
+        'unique constraint promoted to primary key with uniq_to_primary';
+
     is($moniker2, 'LoaderTest2X', "moniker_map testing");
 
     SKIP: {
@@ -577,12 +574,12 @@ sub test_schema {
         );
 
         is(
-            sprintf("%.3f", $class35->column_info('a_double')->{default_value}), '10.555',
+            sprintf("%.3f", $class35->column_info('a_double')->{default_value}||0), '10.555',
             'constant numeric default',
         );
 
         is(
-            sprintf("%.3f", $class35->column_info('a_negative_double')->{default_value}), -10.555,
+            sprintf("%.3f", $class35->column_info('a_negative_double')->{default_value}||0), -10.555,
             'constant negative numeric default',
         );
 
@@ -595,8 +592,17 @@ sub test_schema {
         );
     }
 
+    is( $class2->column_info('crumb_crisp_coating')->{accessor},  'trivet',
+        'col_accessor_map is being run' );
+
+    is $class1->column_info('dat')->{is_nullable}, 0,
+        'is_nullable=0 detection';
+
+    is $class2->column_info('set_primary_key')->{is_nullable}, 1,
+        'is_nullable=1 detection';
+
     SKIP: {
-        skip $self->{skip_rels}, 132 if $self->{skip_rels};
+        skip $self->{skip_rels}, 131 if $self->{skip_rels};
 
         my $moniker3 = $monikers->{loader_test3};
         my $class3   = $classes->{loader_test3};
@@ -738,9 +744,6 @@ sub test_schema {
         my $rs_rel4 = try { $obj3->search_related('loader_test4zes') };
         isa_ok( try { $rs_rel4->first }, $class4);
 
-        is( $class4->column_info('crumb_crisp_coating')->{accessor},  'trivet',
-            'col_accessor_map is being run' );
-
         # check rel naming with prepositions
         ok ($rsobj4->result_source->has_relationship('loader_test5s_to'),
             "rel with preposition 'to' pluralized correctly");
@@ -1123,8 +1126,10 @@ EOF
 
         find $find_cb, DUMP_DIR;
 
-#        system "rm -f /tmp/before_rescan/* /tmp/after_rescan/*";
-#        system "cp $tdir/common_dump/DBIXCSL_Test/Schema/*.pm /tmp/before_rescan";
+#        system "rm -rf /tmp/before_rescan /tmp/after_rescan";
+#        system "mkdir /tmp/before_rescan";
+#        system "mkdir /tmp/after_rescan";
+#        system "cp -a @{[DUMP_DIR]} /tmp/before_rescan";
 
         my $before_digest = $digest->b64digest;
 
@@ -1139,7 +1144,7 @@ EOF
 
         is_deeply(\@new, [ qw/LoaderTest30/ ], "Rescan");
 
-#        system "cp t/_common_dump/DBIXCSL_Test/Schema/*.pm /tmp/after_rescan";
+#        system "cp -a @{[DUMP_DIR]} /tmp/after_rescan";
 
         $digest = Digest::MD5->new;
         find $find_cb, DUMP_DIR;
@@ -1370,6 +1375,7 @@ sub create {
         q{ INSERT INTO loader_test1s (dat) VALUES('baz') }, 
 
         # also test method collision
+        # crumb_crisp_coating is for col_accessor_map tests
         qq{ 
             CREATE TABLE loader_test2 (
                 id $self->{auto_inc_pk},
@@ -1383,6 +1389,7 @@ sub create {
                 meta INTEGER $self->{null},
                 test_role_method INTEGER $self->{null},
                 test_role_for_map_method INTEGER $self->{null},
+                crumb_crisp_coating VARCHAR(32) $self->{null},
                 UNIQUE (dat2, dat)
             ) $self->{innodb}
         },
@@ -1438,6 +1445,19 @@ sub create {
                 c_char_as_data VARCHAR(100)
             ) $self->{innodb}
         },
+        qq{
+            CREATE TABLE loader_test50 (
+                id INTEGER NOT NULL UNIQUE,
+                id1 INTEGER NOT NULL,
+                id2 INTEGER NOT NULL,
+                @{[ $self->{vendor} !~ /^(?:DB2|SQLAnywhere)\z/i ? "
+                    id3 INTEGER $self->{null},
+                    id4 INTEGER NOT NULL,
+                    UNIQUE (id3, id4),
+                " : '' ]}
+                    UNIQUE (id1, id2)
+            ) $self->{innodb}
+        },
     );
 
     # some DBs require mixed case identifiers to be quoted
@@ -1461,7 +1481,6 @@ sub create {
                 id INTEGER NOT NULL PRIMARY KEY,
                 fkid INTEGER NOT NULL,
                 dat VARCHAR(32),
-                crumb_crisp_coating VARCHAR(32) $self->{null},
                 belongs_to INTEGER $self->{null},
                 set_primary_key INTEGER $self->{null},
                 FOREIGN KEY( fkid ) REFERENCES loader_test3 (id),
@@ -1852,7 +1871,14 @@ sub create {
     $dbh->do($_) foreach (@statements);
 
     if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) {
-        $dbh->do($_) foreach (@{ $self->{data_type_tests}{ddl} || [] });
+        foreach my $ddl (@{ $self->{data_type_tests}{ddl} || [] }) {
+            if (my $cb = $self->{data_types_ddl_cb}) {
+                $cb->($ddl);
+            }
+            else {
+                $dbh->do($ddl);
+            }
+        }
     }
 
     unless ($self->{skip_rels}) {
@@ -1897,6 +1923,7 @@ sub drop_tables {
         LoAdEr_test24
         loader_test35
         loader_test36
+        loader_test50
     /;
     
     my @tables_auto_inc = (
@@ -2109,15 +2136,16 @@ sub setup_data_type_tests {
         my %seen_col_names;
 
         while (my ($col_def, $expected_info) = each %$types) {
-            (my $type_alias = $col_def) =~ s/\( ([^)]+) \)//xg;
+            (my $type_alias = $col_def) =~ s/\( (.+) \)(?=(?:[^()]* '(?:[^']* (?:''|\\')* [^']*)* [^\\']' [^()]*)*\z)//xg;
 
             my $size = $1;
             $size = '' unless defined $size;
+            $size = '' unless $size =~ /^[\d, ]+\z/;
             $size =~ s/\s+//g;
             my @size = split /,/, $size;
 
             # some DBs don't like very long column names
-            if ($self->{vendor} =~ /^(?:firebird|sqlanywhere|oracle|db2)\z/i) {
+            if ($self->{vendor} =~ /^(?:Firebird|SQLAnywhere|Oracle|DB2)\z/i) {
                 my ($col_def, $default) = $type_alias =~ /^(.*)(default.*)?\z/i;
 
                 $type_alias = substr $col_def, 0, 15;