flying pigs. almost as likely as win32 doing what you wanted it to.

[dbsrgits/DBIx-Class-Schema-Loader.git] / t / lib / dbixcsl_common_tests.pm

diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index 5c15161..4ee6d78 100644 (file)
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -12,11 +12,10 @@ use DBI;
 use Digest::MD5;
 use File::Find 'find';
 use Class::Unload ();
-use DBIx::Class::Schema::Loader::Utils 'dumper_squashed';
+use DBIx::Class::Schema::Loader::Utils qw/dumper_squashed slurp_file/;
 use List::MoreUtils 'apply';
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
-use File::Slurp 'read_file';
 use File::Spec::Functions 'catfile';
 use File::Basename 'basename';
 use namespace::clean;
@@ -120,7 +119,7 @@ sub run_tests {
     $num_rescans++ if $self->{vendor} eq 'Firebird';
 
     plan tests => @connect_info *
-        (209 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+        (210 + $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];
@@ -156,7 +155,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;
@@ -223,6 +229,7 @@ sub setup_schema {
           qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)[_-]?)?loader[_-]?test[0-9]+(?!.*_)/i,
         result_namespace        => RESULT_NAMESPACE,
         resultset_namespace     => RESULTSET_NAMESPACE,
+        schema_components       => [ 'TestSchemaComponent', '+TestSchemaComponentFQN' ],
         additional_classes      => 'TestAdditional',
         additional_base_classes => 'TestAdditionalBase',
         left_base_classes       => [ qw/TestLeftBase/ ],
@@ -375,7 +382,7 @@ sub test_schema {
         'Result files dumped to first entry in result_namespace';
 
     # parse out the resultset_namespace
-    my $schema_code = read_file($conn->_loader->get_dump_filename(SCHEMA_CLASS), binmode => ':encoding(UTF-8)');
+    my $schema_code = slurp_file $conn->_loader->get_dump_filename(SCHEMA_CLASS);
 
     my ($schema_resultset_namespace) = $schema_code =~ /\bresultset_namespace => (.*)/;
     $schema_resultset_namespace = eval $schema_resultset_namespace;
@@ -384,6 +391,10 @@ sub test_schema {
     is_deeply $schema_resultset_namespace, RESULTSET_NAMESPACE,
         'resultset_namespace set correctly on Schema';
 
+    like $schema_code,
+qr/\n__PACKAGE__->load_components\("TestSchemaComponent", "\+TestSchemaComponentFQN"\);\n\n__PACKAGE__->load_namespaces/,
+        'schema_components works';
+
     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 crumb_crisp_coating/ ], "Column Ordering" );
 
@@ -812,7 +823,7 @@ sub test_schema {
                        $class6->column_info('Id2');
         ok($id2_info->{is_foreign_key}, 'Foreign key detected');
 
-        unlike read_file($conn->_loader->get_dump_filename($class6), binmode => ':encoding(UTF-8)'),
+        unlike slurp_file $conn->_loader->get_dump_filename($class6),
 qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
     \s+ "(\w+?)"
     .*?
@@ -820,7 +831,7 @@ qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
     \s+ "\1"/xs,
 'did not create two relationships with the same name';
 
-        unlike read_file($conn->_loader->get_dump_filename($class8), binmode => ':encoding(UTF-8)'),
+        unlike slurp_file $conn->_loader->get_dump_filename($class8),
 qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
     \s+ "(\w+?)"
     .*?
@@ -1864,7 +1875,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}) {
@@ -2131,7 +2149,7 @@ sub setup_data_type_tests {
             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;