common tests for schema_base_class and components
[dbsrgits/DBIx-Class-Schema-Loader.git] / t / lib / dbixcsl_common_tests.pm
index 7fa48b4..88d10a4 100644 (file)
@@ -7,21 +7,20 @@ use Test::More;
 use Test::Exception;
 use DBIx::Class::Schema::Loader;
 use Class::Unload;
-use File::Path;
+use File::Path 'rmtree';
 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;
 
-use dbixcsl_test_dir qw/$tdir/;
+use dbixcsl_test_dir '$tdir';
 
 use constant DUMP_DIR => "$tdir/common_dump";
 
@@ -115,12 +114,12 @@ sub run_tests {
     my $extra_count = $self->{extra}{count} || 0;
 
     my $col_accessor_map_tests = 5;
-    my $num_rescans = 5;
+    my $num_rescans = 6;
     $num_rescans++ if $self->{vendor} eq 'mssql';
     $num_rescans++ if $self->{vendor} eq 'Firebird';
 
     plan tests => @connect_info *
-        (210 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+        (214 + $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];
@@ -230,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_base_class       => 'TestSchemaBaseClass',
         schema_components       => [ 'TestSchemaComponent', '+TestSchemaComponentFQN' ],
         additional_classes      => 'TestAdditional',
         additional_base_classes => 'TestAdditionalBase',
@@ -383,7 +383,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;
@@ -393,9 +393,22 @@ sub test_schema {
         'resultset_namespace set correctly on Schema';
 
     like $schema_code,
+qr/\nuse base 'TestSchemaBaseClass';\n\n|\nextends 'TestSchemaBaseClass';\n\n/,
+        'schema_base_class works';
+
+    is $conn->testschemabaseclass, 'TestSchemaBaseClass works',
+        'schema base class works';
+
+    like $schema_code,
 qr/\n__PACKAGE__->load_components\("TestSchemaComponent", "\+TestSchemaComponentFQN"\);\n\n__PACKAGE__->load_namespaces/,
         'schema_components works';
 
+    is $conn->dbix_class_testschemacomponent, 'dbix_class_testschemacomponent works',
+        'schema component works';
+
+    is $conn->testschemacomponent_fqn, 'TestSchemaComponentFQN works',
+        'fully qualified schema component 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" );
 
@@ -579,12 +592,12 @@ qr/\n__PACKAGE__->load_components\("TestSchemaComponent", "\+TestSchemaComponent
         );
 
         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',
         );
 
@@ -803,7 +816,7 @@ qr/\n__PACKAGE__->load_components\("TestSchemaComponent", "\+TestSchemaComponent
             'might_have does not have is_deferrable');
 
         # find on multi-col pk
-        if ($conn->_loader->preserve_case) {
+        if ($conn->loader->preserve_case) {
             my $obj5 = $rsobj5->find({id1 => 1, iD2 => 1});
             is $obj5->i_d2, 1, 'Find on multi-col PK';
         }
@@ -824,7 +837,7 @@ qr/\n__PACKAGE__->load_components\("TestSchemaComponent", "\+TestSchemaComponent
                        $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+?)"
     .*?
@@ -832,7 +845,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+?)"
     .*?
@@ -1185,11 +1198,11 @@ EOF
 
     $self->test_data_types($conn);
 
+    $self->test_preserve_case($conn);
+
     # run extra tests
     $self->{extra}{run}->($conn, $monikers, $classes, $self) if $self->{extra}{run};
 
-    $self->test_preserve_case($conn);
-
     $self->drop_tables unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
 
     $conn->storage->disconnect;
@@ -1255,9 +1268,10 @@ qq| INSERT INTO ${oqt}${table41_name}${cqt} VALUES (1, 1) |,
     );
     $conn->storage->disconnect;
 
-    local $conn->_loader->{preserve_case} = 1;
-    $conn->_loader->_setup;
+    my $orig_preserve_case = $conn->loader->preserve_case;
 
+    $conn->loader->preserve_case(1);
+    $conn->loader->_setup;
     $self->rescan_without_warnings($conn);
 
     if (not $self->{skip_rels}) {
@@ -1274,6 +1288,13 @@ qq| INSERT INTO ${oqt}${table41_name}${cqt} VALUES (1, 1) |,
         is try { $conn->resultset('LoaderTest40')->find(1)->foo3_bar }, 'foo',
             'accessor for mixed-case column name in mixed case table';
     }
+
+    # Further tests may expect preserve_case to be unset, so reset it to the
+    # original value and rescan again.
+
+    $conn->loader->preserve_case($orig_preserve_case);
+    $conn->loader->_setup;
+    $self->rescan_without_warnings($conn);
 }
 
 sub monikers_and_classes {
@@ -1281,16 +1302,14 @@ sub monikers_and_classes {
     my ($monikers, $classes);
 
     foreach my $source_name ($schema_class->sources) {
-        my $table_name = $schema_class->source($source_name)->from;
-
-        $table_name = $$table_name if ref $table_name;
+        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} = $result_class;
 
-        # some DBs (Firebird) uppercase everything
+        # some DBs (Firebird, Oracle) uppercase everything
         $monikers->{lc $table_name} = $source_name;
         $classes->{lc $table_name} = $result_class;
     }
@@ -1365,7 +1384,7 @@ sub create {
 
     $self->drop_tables;
 
-    my $make_auto_inc = $self->{auto_inc_cb} || sub {};
+    my $make_auto_inc = $self->{auto_inc_cb} || sub { return () };
     @statements = (
         qq{
             CREATE TABLE loader_test1s (
@@ -1450,6 +1469,8 @@ sub create {
                 c_char_as_data VARCHAR(100)
             ) $self->{innodb}
         },
+        # DB2 does not allow nullable uniq components, SQLAnywhere automatically
+        # converts nullable uniq components to NOT NULL
         qq{
             CREATE TABLE loader_test50 (
                 id INTEGER NOT NULL UNIQUE,
@@ -2169,7 +2190,7 @@ sub setup_data_type_tests {
                 $col_name .= "_sz_$size_name";
             }
 
-            # XXX would be better to check _loader->preserve_case
+            # XXX would be better to check loader->preserve_case
             $col_name = lc $col_name;
 
             $col_name .= '_' . $seen_col_names{$col_name} if $seen_col_names{$col_name}++;