From: Rafael Kitover Date: Fri, 2 Apr 2010 11:23:52 +0000 (-0400) Subject: ability to run only extra tests X-Git-Tag: 0.06000~11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=00805149785ad04c1cf3c08f4b26ac0436466ed1;p=dbsrgits%2FDBIx-Class-Schema-Loader.git ability to run only extra tests --- diff --git a/t/10sqlite_common.t b/t/10sqlite_common.t index 8676761..bb3d16c 100644 --- a/t/10sqlite_common.t +++ b/t/10sqlite_common.t @@ -81,7 +81,7 @@ my $tester = dbixcsl_common_tests->new( '2 foreign key constraints found'); # test that columns for views are picked up - is $schema->resultset($monikers->{extra_loader_test5})->result_source->column_info('person_id')->{data_type}, 'INTEGER', + is $schema->resultset($monikers->{extra_loader_test5})->result_source->column_info('person_id')->{data_type}, 'integer', 'columns for views are introspected'; }, }, diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index 90184cf..ce381b1 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -79,8 +79,15 @@ sub run_tests { push @connect_info, [ @{$info}{qw/dsn user password connect_info_opts/ } ]; } } + + if ($ENV{SCHEMA_LOADER_TESTS_EXTRA_ONLY}) { + $self->run_only_extra_tests(\@connect_info); + return; + } - plan tests => @connect_info * (174 + ($self->{extra}{count} || 0) + ($self->{data_type_tests}{test_count} || 0)); + my $extra_count = $self->{extra}{count} || 0; + + plan tests => @connect_info * (174 + $extra_count + ($self->{data_type_tests}{test_count} || 0)); foreach my $info_idx (0..$#connect_info) { my $info = $connect_info[$info_idx]; @@ -89,7 +96,7 @@ sub run_tests { $self->create(); - my $schema_class = $self->setup_schema(@$info); + my $schema_class = $self->setup_schema($info); $self->test_schema($schema_class); rmtree $DUMP_DIR @@ -97,14 +104,35 @@ sub run_tests { } } +sub run_only_extra_tests { + my ($self, $connect_info) = @_; + + plan tests => @$connect_info * (4 + ($self->{extra}{count} || 0)); + + foreach my $info (@$connect_info) { + @{$self}{qw/dsn user password connect_info_opts/} = @$info; + + my $dbh = $self->dbconnect(0); + $dbh->do($_) for @{ $self->{extra}{create} || [] }; + $self->{_created} = 1; + + my $result_count = grep /CREATE (?:TABLE|VIEW)/i, @{ $self->{extra}{create} || [] }; + + my $schema_class = $self->setup_schema($info, $result_count + 1); + my ($monikers, $classes) = $self->monikers_and_classes($schema_class); + my $conn = $schema_class->clone; + + $self->{extra}{run}->($conn, $monikers, $classes) if $self->{extra}{run}; + } +} + # defined in sub create my (@statements, @statements_reltests, @statements_advanced, @statements_advanced_sqlite, @statements_inline_rels, @statements_implicit_rels); sub setup_schema { - my $self = shift; - my @connect_info = @_; + my ($self, $connect_info, $expected_count) = @_; my $schema_class = 'DBIXCSL_Test::Schema'; @@ -136,7 +164,6 @@ sub setup_schema { Class::Unload->unload($schema_class); my $file_count; - my $expected_count = 36 + ($self->{data_type_tests}{test_count} ? 1 : 0); { my @loader_warnings; local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); }; @@ -145,24 +172,30 @@ sub setup_schema { use base qw/DBIx::Class::Schema::Loader/; __PACKAGE__->loader_options(\%loader_opts); - __PACKAGE__->connection(\@connect_info); + __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}; + + my $standard_sources = not defined $expected_count; + + if ($standard_sources) { + $expected_count = 36 + ($self->{data_type_tests}{test_count} ? 1 : 0); + + $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'; @@ -175,19 +208,27 @@ sub setup_schema { $warn_count++ for grep /\b(?!loader_test9)\w+ has no primary key/i, @loader_warnings; - if($self->{skip_rels}) { - SKIP: { - is(scalar(@loader_warnings), $warn_count, "No 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 warning") or diag @loader_warnings; - skip "No missing PK warnings without rels", 1; + is(grep(/loader_test9 has no primary key/i, @loader_warnings), 1, + "Missing PK warning"); } } else { - $warn_count++; - is(scalar(@loader_warnings), $warn_count, "Expected loader warning") - or diag @loader_warnings; - is(grep(/loader_test9 has no primary key/i, @loader_warnings), 1, - "Missing PK warning"); + SKIP: { + is scalar(@loader_warnings), $warn_count, 'Correct number of warnings'; + skip "not testing standard sources", 1; + } } } @@ -204,20 +245,7 @@ sub test_schema { ($self->{before_tests_run} || sub {})->($conn); - my $monikers = {}; - my $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; - - $monikers->{$table_name} = $source_name; - $classes->{$table_name} = $schema_class . q{::} . $source_name; - - # some DBs (Firebird) uppercase everything - $monikers->{lc $table_name} = $source_name; - $classes->{lc $table_name} = $schema_class . q{::} . $source_name; - } + my ($monikers, $classes) = $self->monikers_and_classes($schema_class); my $moniker1 = $monikers->{loader_test1s}; my $class1 = $classes->{loader_test1s}; @@ -902,6 +930,26 @@ sub test_schema { $conn->storage->disconnect; } +sub monikers_and_classes { + my ($self, $schema_class) = @_; + 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; + + $monikers->{$table_name} = $source_name; + $classes->{$table_name} = $schema_class . q{::} . $source_name; + + # some DBs (Firebird) uppercase everything + $monikers->{lc $table_name} = $source_name; + $classes->{lc $table_name} = $schema_class . q{::} . $source_name; + } + + return ($monikers, $classes); +} + sub check_no_duplicate_unique_constraints { my ($class) = @_;