X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2Fdbixcsl_common_tests.pm;h=f8ce130f5afa3a778f1c906e2ca7885271def507;hb=716870937ce4575f397fd50b9cf5c54d260f97cc;hp=e19c3d8f82d21f4d542f8eba1c68602298639cb3;hpb=ebed3e6e3e487ab926341b75e56cd428ae1f1419;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index e19c3d8..f8ce130 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -15,6 +15,7 @@ use Class::Unload (); use DBIx::Class::Schema::Loader::Utils 'dumper_squashed'; use List::MoreUtils 'apply'; use DBIx::Class::Schema::Loader::Optional::Dependencies (); +use Try::Tiny; use namespace::clean; use dbixcsl_test_dir qw/$tdir/; @@ -22,6 +23,8 @@ use dbixcsl_test_dir qw/$tdir/; my $DUMP_DIR = "$tdir/common_dump"; rmtree $DUMP_DIR; +use constant RESCAN_WARNINGS => qr/(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method|invalidates \d+ active statement|^Bad table or view/; + sub new { my $class = shift; @@ -92,7 +95,14 @@ sub run_tests { my $extra_count = $self->{extra}{count} || 0; - plan tests => @connect_info * (182 + $extra_count + ($self->{data_type_tests}{test_count} || 0)); + my $column_accessor_map_tests = 5; + my $num_rescans = 5; + $num_rescans-- if $self->{vendor} =~ /^(?:sybase|mysql)\z/i; + $num_rescans++ if $self->{vendor} eq 'mssql'; + $num_rescans++ if $self->{vendor} eq 'Firebird'; + + plan tests => @connect_info * + (183 + $num_rescans * $column_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]; @@ -124,29 +134,28 @@ sub run_only_extra_tests { $self->drop_extra_tables_only; my $dbh = $self->dbconnect(1); - { - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; + $dbh->do($_) for @{ $self->{pre_create} || [] }; + $dbh->do($_) for @{ $self->{extra}{create} || [] }; - - $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} || []}; } + $self->{_created} = 1; my $file_count = grep /CREATE (?:TABLE|VIEW)/i, @{ $self->{extra}{create} || [] }; $file_count++; # schema - $file_count++ for @{ $self->{data_type_tests}{table_names} || [] }; + + if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) { + $file_count++ for @{ $self->{data_type_tests}{table_names} || [] }; + } 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}; + $self->{extra}{run}->($conn, $monikers, $classes, $self) if $self->{extra}{run}; if (not ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} && $info_idx == $#$connect_info)) { $self->drop_extra_tables_only; @@ -160,15 +169,13 @@ sub drop_extra_tables_only { my $dbh = $self->dbconnect(0); - { - local $SIG{__WARN__} = sub {}; # postgres notices - $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; - } - + $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] }; - foreach my $data_type_table (@{ $self->{data_type_tests}{table_names} || [] }) { - $dbh->do("DROP TABLE $data_type_table"); + if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) { + foreach my $data_type_table (@{ $self->{data_type_tests}{table_names} || [] }) { + $dbh->do("DROP TABLE $data_type_table"); + } } } @@ -201,8 +208,7 @@ sub setup_schema { additional_classes => 'TestAdditional', additional_base_classes => 'TestAdditionalBase', left_base_classes => [ qw/TestLeftBase/ ], - components => [ qw/TestComponent/ ], - resultset_components => [ qw/TestRSComponent/ ], + components => [ qw/TestComponent +TestComponentFQN/ ], inflect_plural => { loader_test4 => 'loader_test4zes' }, inflect_singular => { fkid => 'fkid_singular' }, moniker_map => \&_monikerize, @@ -213,6 +219,8 @@ sub setup_schema { datetime_timezone => 'Europe/Berlin', datetime_locale => 'de_DE', use_moose => $ENV{SCHEMA_LOADER_TESTS_USE_MOOSE}, + col_collision_map => { '^(can)\z' => 'caught_collision_%s' }, + column_accessor_map => \&test_column_accessor_map, %{ $self->{loader_options} || {} }, ); @@ -223,7 +231,7 @@ sub setup_schema { my $file_count; { my @loader_warnings; - local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); }; + local $SIG{__WARN__} = sub { push(@loader_warnings, @_); }; eval qq{ package $schema_class; use base qw/DBIx::Class::Schema::Loader/; @@ -240,7 +248,10 @@ sub setup_schema { if ($standard_sources) { $expected_count = 36; - $expected_count++ for @{ $self->{data_type_tests}{table_names} || [] }; + + if (not ($self->{vendor} eq 'mssql' && $connect_info->[0] =~ /Sybase/)) { + $expected_count++ for @{ $self->{data_type_tests}{table_names} || [] }; + } $expected_count += grep /CREATE (?:TABLE|VIEW)/i, @{ $self->{extra}{create} || [] }; @@ -258,7 +269,6 @@ sub setup_schema { is $file_count, $expected_count, 'correct number of files generated'; my $warn_count = 2; - $warn_count++ if grep /ResultSetManager/, @loader_warnings; $warn_count++ for grep /^Bad table or view/, @loader_warnings; @@ -266,8 +276,12 @@ sub setup_schema { $warn_count++ for grep /\b(?!loader_test9)\w+ has no primary key/i, @loader_warnings; + $warn_count++ for grep /^Column \w+ in table \w+ collides with an inherited method\./, @loader_warnings; + $warn_count++ for grep { my $w = $_; grep $w =~ $_, @{ $self->{warnings} || [] } } @loader_warnings; + $warn_count-- for grep { my $w = $_; grep $w =~ $_, @{ $self->{failtrigger_warnings} || [] } } @loader_warnings; + if ($standard_sources) { if($self->{skip_rels}) { SKIP: { @@ -293,7 +307,7 @@ sub setup_schema { } } - exit if $file_count != $expected_count; + exit if ($file_count||0) != $expected_count; return $schema_class; } @@ -337,7 +351,10 @@ sub test_schema { isa_ok( $rsobj35, "DBIx::Class::ResultSet" ); my @columns_lt2 = $class2->columns; - is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key dbix_class_testcomponent meta/ ], "Column Ordering" ); + is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent meta/ ], "Column Ordering" ); + + is $class2->column_info('can')->{accessor}, 'caught_collision_can', + 'accessor for column name that conflicts with a UNIVERSAL method renamed based on col_collision_map'; is $class2->column_info('set_primary_key')->{accessor}, undef, 'accessor for column name that conflicts with a result base class method removed'; @@ -406,13 +423,8 @@ sub test_schema { 'Additional Component' ); } - SKIP: { - can_ok($rsobj1, 'dbix_class_testrscomponent') - or skip "Pre-requisite test failed", 1; - is( $rsobj1->dbix_class_testrscomponent, - 'dbix_class_testrscomponent works', - 'ResultSet component' ); - } + is ((try { $class1->testcomponent_fqn }), 'TestComponentFQN works', + 'fully qualified component class'); SKIP: { can_ok( $class1, 'loader_test1_classmeth' ) @@ -420,12 +432,6 @@ sub test_schema { is( $class1->loader_test1_classmeth, 'all is well', 'Class method' ); } - SKIP: { - can_ok( $rsobj1, 'loader_test1_rsmeth' ) - or skip "Pre-requisite test failed"; - is( $rsobj1->loader_test1_rsmeth, 'all is still well', 'Result set method' ); - } - ok( $class1->column_info('id')->{is_auto_increment}, 'is_auto_increment detection' ); my $obj = $rsobj1->find(1); @@ -614,6 +620,9 @@ sub test_schema { my $rs_rel4 = $obj3->search_related('loader_test4zes'); isa_ok( $rs_rel4->first, $class4); + is( $class4->column_info('crumb_crisp_coating')->{accessor}, 'trivet', + 'column_accessor_map is being run' ); + # check rel naming with prepositions ok ($rsobj4->result_source->has_relationship('loader_test5s_to'), "rel with preposition 'to' pluralized correctly"); @@ -834,7 +843,7 @@ sub test_schema { } SKIP: { - skip 'This vendor cannot do inline relationship definitions', 9 + skip 'This vendor cannot do inline relationship definitions', 11 if $self->{no_inline_rels}; my $moniker12 = $monikers->{loader_test12}; @@ -859,6 +868,27 @@ sub test_schema { my $obj12 = $rsobj12->find(1); isa_ok( $obj12->loader_test13, $class13 ); + + # relname is preserved when another fk is added + + skip 'Sybase cannot add FKs via ALTER TABLE', 2 + if $self->{vendor} eq 'sybase'; + + { + local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /invalidates \d+ active statement/ }; + $conn->storage->disconnect; # for mssql + } + + isa_ok $rsobj3->find(1)->loader_test4zes, 'DBIx::Class::ResultSet'; + + $conn->storage->dbh->do('ALTER TABLE loader_test4 ADD fkid2 INTEGER REFERENCES loader_test3 (id)'); + + $conn->storage->disconnect; # for firebird + + $self->rescan_without_warnings($conn); + + isa_ok eval { $rsobj3->find(1)->loader_test4zes }, 'DBIx::Class::ResultSet', + 'relationship name preserved when another foreign key is added in remote table'; } SKIP: { @@ -936,26 +966,13 @@ sub test_schema { $conn->storage->disconnect; # needed for Firebird and Informix my $dbh = $self->dbconnect(1); - - { - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; - - $dbh->do($_) for @statements_rescan; - } - + $dbh->do($_) for @statements_rescan; $dbh->disconnect; sleep 1; - my @new = do { - # kill the 'Dumping manual schema' warnings - local $SIG{__WARN__} = sub {}; - $conn->rescan; - }; + my @new = $self->rescan_without_warnings($conn); + is_deeply(\@new, [ qw/LoaderTest30/ ], "Rescan"); # system "cp t/_common_dump/DBIXCSL_Test/Schema/*.pm /tmp/after_rescan"; @@ -983,10 +1000,8 @@ sub test_schema { $conn->storage->disconnect; # for Firebird $conn->storage->dbh->do("DROP TABLE loader_test30"); - @new = do { - local $SIG{__WARN__} = sub {}; - $conn->rescan; - }; + @new = $self->rescan_without_warnings($conn); + is_deeply(\@new, [], 'no new tables on rescan'); throws_ok { $conn->resultset('LoaderTest30') } @@ -997,7 +1012,7 @@ sub test_schema { $self->test_data_types($conn); # run extra tests - $self->{extra}{run}->($conn, $monikers, $classes) if $self->{extra}{run}; + $self->{extra}{run}->($conn, $monikers, $classes, $self) if $self->{extra}{run}; $self->test_preserve_case($conn); @@ -1009,24 +1024,30 @@ sub test_schema { sub test_data_types { my ($self, $conn) = @_; - if ($self->{data_type_tests}{test_count}) { - my $data_type_tests = $self->{data_type_tests}; + SKIP: { + if (my $test_count = $self->{data_type_tests}{test_count}) { + if ($self->{vendor} eq 'mssql' && $conn->storage->dbh->{Driver}{Name} eq 'Sybase') { + skip 'DBD::Sybase does not work with the data_type tests on latest SQL Server', $test_count; + } + + my $data_type_tests = $self->{data_type_tests}; - foreach my $moniker (@{ $data_type_tests->{table_monikers} }) { - my $columns = $data_type_tests->{columns}{$moniker}; + foreach my $moniker (@{ $data_type_tests->{table_monikers} }) { + my $columns = $data_type_tests->{columns}{$moniker}; - my $rsrc = $conn->resultset($moniker)->result_source; + my $rsrc = $conn->resultset($moniker)->result_source; - while (my ($col_name, $expected_info) = each %$columns) { - my %info = %{ $rsrc->column_info($col_name) }; - delete @info{qw/is_nullable timezone locale sequence/}; + while (my ($col_name, $expected_info) = each %$columns) { + my %info = %{ $rsrc->column_info($col_name) }; + delete @info{qw/is_nullable timezone locale sequence/}; - my $text_col_def = dumper_squashed \%info; + my $text_col_def = dumper_squashed \%info; - my $text_expected_info = dumper_squashed $expected_info; + my $text_expected_info = dumper_squashed $expected_info; - is_deeply \%info, $expected_info, - "test column $col_name has definition: $text_col_def expecting: $text_expected_info"; + is_deeply \%info, $expected_info, + "test column $col_name has definition: $text_col_def expecting: $text_expected_info"; + } } } } @@ -1037,16 +1058,9 @@ sub test_preserve_case { my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1); # open quote, close quote - my $dbh = $conn->storage->dbh; + my $dbh = $self->dbconnect; - { - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; - - $dbh->do($_) for ( + $dbh->do($_) for ( qq| CREATE TABLE ${oqt}LoaderTest40${cqt} ( ${oqt}Id${cqt} INTEGER NOT NULL PRIMARY KEY, @@ -1062,17 +1076,13 @@ qq| |, qq| INSERT INTO ${oqt}LoaderTest40${cqt} VALUES (1, 'foo') |, qq| INSERT INTO ${oqt}LoaderTest41${cqt} VALUES (1, 1) |, - ); - } + ); $conn->storage->disconnect; local $conn->_loader->{preserve_case} = 1; $conn->_loader->_setup; - { - local $SIG{__WARN__} = sub {}; - $conn->rescan; - } + $self->rescan_without_warnings($conn); if (not $self->{skip_rels}) { is $conn->resultset('LoaderTest41')->find(1)->loader_test40->foo3_bar, 'foo', @@ -1192,6 +1202,7 @@ sub create { dat VARCHAR(32) NOT NULL, dat2 VARCHAR(32) NOT NULL, set_primary_key INTEGER $self->{null}, + can INTEGER $self->{null}, dbix_class_testcomponent INTEGER $self->{null}, meta INTEGER $self->{null}, UNIQUE (dat2, dat) @@ -1261,6 +1272,7 @@ sub create { id INTEGER NOT NULL PRIMARY KEY, fkid INTEGER NOT NULL, dat VARCHAR(32), + crumb_crisp_coating VARCHAR(32) $self->{null}, FOREIGN KEY( fkid ) REFERENCES loader_test3 (id) ) $self->{innodb} }, @@ -1610,15 +1622,13 @@ sub create { my $dbh = $self->dbconnect(1); - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; + $dbh->do($_) for @{ $self->{pre_create} || [] }; $dbh->do($_) foreach (@statements); - $dbh->do($_) foreach (@{ $self->{data_type_tests}{ddl} || [] }); + if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) { + $dbh->do($_) foreach (@{ $self->{data_type_tests}{ddl} || [] }); + } unless($self->{skip_rels}) { # hack for now, since DB2 doesn't like inline comments, and we need @@ -1720,48 +1730,47 @@ sub drop_tables { # For some reason some tests do this twice (I guess dependency issues?) # do it twice for all drops for (1,2) { - my $dbh = $self->dbconnect(0); + my $dbh = $self->dbconnect(0); - { - local $SIG{__WARN__} = sub {}; # postgres notices $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; - } - $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] }; + $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] }; - my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {}; + my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {}; - unless($self->{skip_rels}) { - $dbh->do("DROP TABLE $_") for (@tables_reltests); - $dbh->do("DROP TABLE $_") for (@tables_reltests); - if($self->{vendor} =~ /mysql/i) { - $dbh->do($drop_fk_mysql); - } - else { - $dbh->do($drop_fk); - } - $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc; - $dbh->do("DROP TABLE $_") for (@tables_advanced); + unless($self->{skip_rels}) { + $dbh->do("DROP TABLE $_") for (@tables_reltests); + $dbh->do("DROP TABLE $_") for (@tables_reltests); + if($self->{vendor} =~ /mysql/i) { + $dbh->do($drop_fk_mysql); + } + else { + $dbh->do($drop_fk); + } + $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc; + $dbh->do("DROP TABLE $_") for (@tables_advanced); - unless($self->{no_inline_rels}) { - $dbh->do("DROP TABLE $_") for (@tables_inline_rels); - } - unless($self->{no_implicit_rels}) { - $dbh->do("DROP TABLE $_") for (@tables_implicit_rels); + unless($self->{no_inline_rels}) { + $dbh->do("DROP TABLE $_") for (@tables_inline_rels); + } + unless($self->{no_implicit_rels}) { + $dbh->do("DROP TABLE $_") for (@tables_implicit_rels); + } } - } - $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc; - $dbh->do("DROP TABLE $_") for (@tables, @tables_rescan); + $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc; + $dbh->do("DROP TABLE $_") for (@tables, @tables_rescan); - foreach my $data_type_table (@{ $self->{data_type_tests}{table_names} || [] }) { - $dbh->do("DROP TABLE $data_type_table"); - } + if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) { + foreach my $data_type_table (@{ $self->{data_type_tests}{table_names} || [] }) { + $dbh->do("DROP TABLE $data_type_table"); + } + } - my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1); + my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1); - $dbh->do("DROP TABLE ${oqt}${_}${cqt}") for @tables_preserve_case_tests; + $dbh->do("DROP TABLE ${oqt}${_}${cqt}") for @tables_preserve_case_tests; - $dbh->disconnect; + $dbh->disconnect; } } @@ -1882,6 +1891,27 @@ sub setup_data_type_tests { return $test_count; } +sub rescan_without_warnings { + my ($self, $conn) = @_; + + local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ RESCAN_WARNINGS }; + return $conn->rescan; +} + +sub test_column_accessor_map { + my ( $column_name, $default_name, $context ) = @_; + if( lc($column_name) eq 'crumb_crisp_coating' ) { + + is( $default_name, 'crumb_crisp_coating', 'column_accessor_map was passed the default name' ); + ok( $context->{$_}, "column_accessor_map func was passed the $_" ) + for qw( table_name table_class table_moniker schema_class ); + + return 'trivet'; + } else { + return $default_name; + } +} + sub DESTROY { my $self = shift; unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {