X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F99dbic_sqlt_parser.t;h=b98e7f2a40982711ba60891d12f36f9966635577;hb=331886ef1b5ab7a732915b8213dd525a3ea63b88;hp=4d1ddac4b5924e875ad0fb3b1c352e5461c6a797;hpb=a7acf09f13db3be864181e4ed3dca15c0faab80d;p=dbsrgits%2FDBIx-Class.git diff --git a/t/99dbic_sqlt_parser.t b/t/99dbic_sqlt_parser.t index 4d1ddac..b98e7f2 100644 --- a/t/99dbic_sqlt_parser.t +++ b/t/99dbic_sqlt_parser.t @@ -3,29 +3,43 @@ use warnings; use Test::More; use Test::Exception; +use Scalar::Util (); + use lib qw(t/lib); use DBICTest; -use DBICTest::Schema; -use Scalar::Util (); BEGIN { - require DBIx::Class::Storage::DBI; + require DBIx::Class; plan skip_all => - 'Test needs SQL::Translator ' . DBIx::Class::Storage::DBI->_sqlt_minimum_version - if not DBIx::Class::Storage::DBI->_sqlt_version_ok; + 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') + unless DBIx::Class::Optional::Dependencies->req_ok_for ('deploy') } # Test for SQLT-related leaks { my $s = DBICTest::Schema->clone; - create_schema ({ schema => $s }); + + my @schemas = ( + create_schema ({ schema => $s }), + create_schema ({ args => { parser_args => { 'DBIx::Class::Schema' => $s } } }), + create_schema ({ args => { parser_args => { 'DBIx::Schema' => $s } } }), + create_schema ({ args => { parser_args => { package => $s } } }), + ); + Scalar::Util::weaken ($s); ok (!$s, 'Schema not leaked'); + + isa_ok ($_, 'SQL::Translator::Schema', "SQLT schema object $_ produced") + for @schemas; } +# make sure classname-style works +lives_ok { isa_ok (create_schema ({ schema => 'DBICTest::Schema' }), 'SQL::Translator::Schema', 'SQLT schema object produced') }; + + +my $schema = DBICTest->init_schema( no_deploy => 1 ); -my $schema = DBICTest->init_schema(); # Dummy was yanked out by the sqlt hook test # CustomSql tests the horrific/deprecated ->name(\$sql) hack # YearXXXXCDs are views @@ -35,35 +49,50 @@ my @sources = grep $schema->sources ; -{ +my $idx_exceptions = { + 'Artwork' => -1, + 'ForceForeign' => -1, + 'LinerNotes' => -1, + 'TwoKeys' => -1, # TwoKeys has the index turned off on the rel def +}; + +{ my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } }); - foreach my $source (@sources) { - my $table = get_table($sqlt_schema, $schema, $source); + foreach my $source_name (@sources) { + my $table = get_table($sqlt_schema, $schema, $source_name); my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints); + $fk_count += $idx_exceptions->{$source_name} || 0; my @indices = $table->get_indices; + my $index_count = scalar(@indices); - $index_count++ if ($source eq 'TwoKeys'); # TwoKeys has the index turned off on the rel def - is($index_count, $fk_count, "correct number of indices for $source with no args"); + is($index_count, $fk_count, "correct number of indices for $source_name with no args"); + + for my $index (@indices) { + my $source = $schema->source($source_name); + my $pk_test = join("\x00", $source->primary_columns); + my $idx_test = join("\x00", $index->fields); + isnt ( $pk_test, $idx_test, "no additional index for the primary columns exists in $source_name"); + } } } -{ +{ my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 1 } } }); - foreach my $source (@sources) { - my $table = get_table($sqlt_schema, $schema, $source); + foreach my $source_name (@sources) { + my $table = get_table($sqlt_schema, $schema, $source_name); my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints); + $fk_count += $idx_exceptions->{$source_name} || 0; my @indices = $table->get_indices; my $index_count = scalar(@indices); - $index_count++ if ($source eq 'TwoKeys'); # TwoKeys has the index turned off on the rel def - is($index_count, $fk_count, "correct number of indices for $source with add_fk_index => 1"); + is($index_count, $fk_count, "correct number of indices for $source_name with add_fk_index => 1"); } } -{ +{ my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 0 } } }); foreach my $source (@sources) { @@ -75,7 +104,7 @@ my @sources = grep } } -{ +{ { package # hide from PAUSE DBICTest::Schema::NoViewDefinition; @@ -114,6 +143,69 @@ lives_ok (sub { }); +{ + package DBICTest::PartialSchema; + + use base qw/DBIx::Class::Schema/; + + __PACKAGE__->load_classes( + { 'DBICTest::Schema' => [qw/ + CD + Track + Tag + Producer + CD_to_Producer + /]} + ); +} + +{ + my $partial_schema = DBICTest::PartialSchema->connect(DBICTest->_database); + + lives_ok (sub { + my $sqlt_schema = do { + + local $SIG{__WARN__} = sub { + warn @_ + unless $_[0] =~ /Ignoring relationship .+ related resultsource .+ is not registered with this schema/ + }; + + create_schema({ schema => $partial_schema }); + }; + + my @tables = $sqlt_schema->get_tables; + + is_deeply ( + [sort map { $_->name } @tables], + [qw/cd cd_to_producer producer tags track/], + 'partial dbic schema parsing ok', + ); + + # the primary key is currently unnamed in sqlt - adding below + my %constraints_for_table = ( + producer => [qw/prod_name /], + tags => [qw/tagid_cd tagid_cd_tag tags_fk_cd tags_tagid_tag tags_tagid_tag_cd /], + track => [qw/track_cd_position track_cd_title track_fk_cd /], + cd => [qw/cd_artist_title cd_fk_single_track /], + cd_to_producer => [qw/cd_to_producer_fk_cd cd_to_producer_fk_producer /], + ); + + for my $table (@tables) { + my $tablename = $table->name; + my @constraints = $table->get_constraints; + is_deeply ( + [ sort map { $_->name } @constraints ], + + # the primary key (present on all loaded tables) is currently named '' in sqlt + # subject to future changes + [ '', @{$constraints_for_table{$tablename}} ], + + "constraints of table '$tablename' ok", + ); + } + }, 'partial schema tests successful'); +} + done_testing; sub create_schema { @@ -123,7 +215,7 @@ sub create_schema { my $additional_sqltargs = $args->{args} || {}; my $sqltargs = { - add_drop_table => 1, + add_drop_table => 1, ignore_constraint_names => 1, ignore_index_names => 1, %{$additional_sqltargs}