sub run_only_extra_tests {
my ($self, $connect_info) = @_;
- plan tests => @$connect_info * (4 + ($self->{extra}{count} || 0));
+ plan tests => @$connect_info * (4 + ($self->{extra}{count} || 0) + ($self->{data_type_tests}{test_count} || 0));
+
+ foreach my $info_idx (0..$#$connect_info) {
+ my $info = $connect_info->[$info_idx];
- foreach my $info (@$connect_info) {
@{$self}{qw/dsn user password connect_info_opts/} = @$info;
- my $dbh = $self->dbconnect(0);
+ $self->drop_extra_tables_only;
+
+ my $dbh = $self->dbconnect(1);
$dbh->do($_) for @{ $self->{extra}{create} || [] };
+ $dbh->do($self->{data_type_tests}{ddl}) if $self->{data_type_tests}{ddl};
$self->{_created} = 1;
- my $result_count = grep /CREATE (?:TABLE|VIEW)/i, @{ $self->{extra}{create} || [] };
+ my $file_count = grep /CREATE (?:TABLE|VIEW)/i, @{ $self->{extra}{create} || [] };
+ $file_count++; # schema
+ $file_count++ if $self->{data_type_tests}{ddl};
- my $schema_class = $self->setup_schema($info, $result_count + 1);
+ my $schema_class = $self->setup_schema($info, $file_count);
my ($monikers, $classes) = $self->monikers_and_classes($schema_class);
my $conn = $schema_class->clone;
+ $self->test_data_types($conn);
$self->{extra}{run}->($conn, $monikers, $classes) if $self->{extra}{run};
+
+ if (not ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} && $info_idx == $#$connect_info)) {
+ $self->drop_extra_tables_only;
+ rmtree $DUMP_DIR;
+ }
+ }
+}
+
+sub drop_extra_tables_only {
+ my $self = shift;
+
+ my $dbh = $self->dbconnect(0);
+ $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] };
+ $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] };
+
+ if (my $data_type_table = $self->{data_type_tests}{table_name}) {
+ $dbh->do("DROP TABLE $data_type_table");
}
}
}
else {
SKIP: {
- is scalar(@loader_warnings), $warn_count, 'Correct number of warnings';
+ is scalar(@loader_warnings), $warn_count, 'Correct number of warnings'
+ or diag @loader_warnings;
skip "not testing standard sources", 1;
}
}
'Foreign key detected');
}
- # test data types
+ $self->test_data_types($conn);
+
+ # run extra tests
+ $self->{extra}{run}->($conn, $monikers, $classes) if $self->{extra}{run};
+
+ $self->drop_tables unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
+
+ $conn->storage->disconnect;
+}
+
+sub test_data_types {
+ my ($self, $conn) = @_;
+
if ($self->{data_type_tests}{test_count}) {
my $data_type_tests = $self->{data_type_tests};
my $columns = $data_type_tests->{columns};
"test column $col_name has definition: $text_col_def expecting: $text_expected_info";
}
}
-
- # run extra tests
- $self->{extra}{run}->($conn, $monikers, $classes) if $self->{extra}{run};
-
- $self->drop_tables unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
-
- $conn->storage->disconnect;
}
sub monikers_and_classes {
$size =~ s/\s+//g;
my @size = split /,/, $size;
+ # Firebird doesn't like very long column names
+ if ($self->{vendor} =~ /^firebird\z/i) {
+ $type_alias =~ s/default\b.*/_with_dflt/i;
+ }
+
$type_alias =~ s/\s/_/g;
$type_alias =~ s/\W//g;