X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2Fdbixcsl_common_tests.pm;h=d3b87f7ece43f3447723a2dab46c0e28a43f3723;hb=1ad8e8c3ce53cba4f8a34e37567ed1187b9e54b8;hp=af46977ddae6e4fed1b7148bf86df85d2d513a33;hpb=1b3e8f7a3780171fc24656cf24177089bcc1267f;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index af46977..d3b87f7 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -12,12 +12,18 @@ use DBI; use Digest::MD5; use File::Find 'find'; use Class::Unload (); -use Data::Dumper::Concise; +use DBIx::Class::Schema::Loader::Utils 'dumper_squashed'; use List::MoreUtils 'apply'; +use DBIx::Class::Schema::Loader::Optional::Dependencies (); +use namespace::clean; -my $DUMP_DIR = './t/_common_dump'; +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; @@ -42,7 +48,7 @@ sub new { # Optional extra tables and tests $self->{extra} ||= {}; - $self->{date_datatype} ||= 'DATE'; + $self->{basic_date_datatype} ||= 'DATE'; # Not all DBS do SQL-standard CURRENT_TIMESTAMP $self->{default_function} ||= "current_timestamp"; @@ -120,17 +126,9 @@ 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->{extra}{create} || [] }; - $dbh->do($_) for @{ $self->{data_type_tests}{ddl} || []}; - } + $dbh->do($_) for @{ $self->{pre_create} || [] }; + $dbh->do($_) for @{ $self->{extra}{create} || [] }; + $dbh->do($_) for @{ $self->{data_type_tests}{ddl} || []}; $self->{_created} = 1; my $file_count = grep /CREATE (?:TABLE|VIEW)/i, @{ $self->{extra}{create} || [] }; @@ -142,7 +140,7 @@ sub run_only_extra_tests { 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; @@ -155,6 +153,7 @@ 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} || [] }; @@ -175,15 +174,24 @@ sub setup_schema { my $debug = ($self->{verbose} > 1) ? 1 : 0; + if ( + $ENV{SCHEMA_LOADER_TESTS_USE_MOOSE} + && + ! DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose') + ) { + die sprintf ("Missing dependencies for SCHEMA_LOADER_TESTS_USE_MOOSE: %s\n", + DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose') + ); + } + my %loader_opts = ( constraint => - qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)_?)?loader_?test[0-9]+(?!.*_)/i, + qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)_?)?loader_?test[0-9]+(?!.*_)/i, relationships => 1, additional_classes => 'TestAdditional', additional_base_classes => 'TestAdditionalBase', left_base_classes => [ qw/TestLeftBase/ ], components => [ qw/TestComponent/ ], - resultset_components => [ qw/TestRSComponent/ ], inflect_plural => { loader_test4 => 'loader_test4zes' }, inflect_singular => { fkid => 'fkid_singular' }, moniker_map => \&_monikerize, @@ -193,6 +201,8 @@ sub setup_schema { dump_directory => $DUMP_DIR, datetime_timezone => 'Europe/Berlin', datetime_locale => 'de_DE', + use_moose => $ENV{SCHEMA_LOADER_TESTS_USE_MOOSE}, + col_collision_map => { '^(can)\z' => 'caught_collision_%s' }, %{ $self->{loader_options} || {} }, ); @@ -203,7 +213,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/; @@ -238,7 +248,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; @@ -246,6 +255,8 @@ 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; if ($standard_sources) { @@ -317,7 +328,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/ ], "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'; @@ -325,6 +339,9 @@ sub test_schema { is $class2->column_info('dbix_class_testcomponent')->{accessor}, undef, 'accessor for column name that conflicts with a component class method removed'; + is $class2->column_info('meta')->{accessor}, undef, + 'accessor for column name that conflicts with Moose removed'; + my %uniq1 = $class1->unique_constraints; my $uniq1_test = 0; foreach my $ucname (keys %uniq1) { @@ -384,25 +401,11 @@ sub test_schema { } 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' ); - } - - SKIP: { can_ok( $class1, 'loader_test1_classmeth' ) or skip "Pre-requisite test failed", 1; 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); @@ -620,8 +623,8 @@ sub test_schema { is $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_update}, 'CASCADE', "on_update => 'CASCADE' on belongs_to by default"; - ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{is_deferrable}), - "is_deferrable => 1 not on belongs_to by default"); + is $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{is_deferrable}, 1, + "is_deferrable => 1 on belongs_to by default"; ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_delete}), 'belongs_to does not have cascade_delete'); @@ -811,7 +814,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}; @@ -836,6 +839,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: { @@ -907,32 +931,19 @@ sub test_schema { find $find_cb, $DUMP_DIR; # system "rm -f /tmp/before_rescan/* /tmp/after_rescan/*"; -# system "cp t/_common_dump/DBIXCSL_Test/Schema/*.pm /tmp/before_rescan"; +# system "cp $tdir/common_dump/DBIXCSL_Test/Schema/*.pm /tmp/before_rescan"; my $before_digest = $digest->b64digest; $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"; @@ -960,10 +971,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') } @@ -974,7 +983,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); @@ -998,19 +1007,9 @@ sub test_data_types { my %info = %{ $rsrc->column_info($col_name) }; delete @info{qw/is_nullable timezone locale sequence/}; - my $text_col_def = do { - my $dd = Dumper; - $dd->Indent(0); - $dd->Values([\%info]); - $dd->Dump; - }; + my $text_col_def = dumper_squashed \%info; - my $text_expected_info = do { - my $dd = Dumper; - $dd->Indent(0); - $dd->Values([$expected_info]); - $dd->Dump; - }; + 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"; @@ -1024,16 +1023,9 @@ sub test_preserve_case { my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1); # open quote, close quote - my $dbh = $conn->storage->dbh; - - { - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; + my $dbh = $self->dbconnect; - $dbh->do($_) for ( + $dbh->do($_) for ( qq| CREATE TABLE ${oqt}LoaderTest40${cqt} ( ${oqt}Id${cqt} INTEGER NOT NULL PRIMARY KEY, @@ -1049,17 +1041,14 @@ 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', @@ -1156,6 +1145,8 @@ sub create { $self->{_created} = 1; + $self->drop_tables; + my $make_auto_inc = $self->{auto_inc_cb} || sub {}; @statements = ( qq{ @@ -1177,7 +1168,9 @@ 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) ) $self->{innodb} }, @@ -1217,7 +1210,7 @@ sub create { qq{ CREATE TABLE loader_test36 ( id INTEGER NOT NULL PRIMARY KEY, - a_date $self->{date_datatype}, + a_date $self->{basic_date_datatype}, b_char_as_data VARCHAR(100), c_char_as_data VARCHAR(100) ) $self->{innodb} @@ -1591,15 +1584,10 @@ sub create { ); $self->drop_tables; - $self->drop_tables; # twice for good measure 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); @@ -1632,6 +1620,7 @@ sub drop_tables { my $self = shift; my @tables = qw/ + loader_test1 loader_test1s loader_test2 LOADER_test23 @@ -1701,14 +1690,18 @@ sub drop_tables { my $drop_fk = q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk}; - my $dbh = $self->dbconnect(0); + # 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); - $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; - $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] }; + $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; - my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {}; + $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] }; - unless($self->{skip_rels}) { + 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) { @@ -1726,24 +1719,20 @@ sub drop_tables { 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} || [] }) { + 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); + } - $dbh->do("DROP TABLE ${oqt}${_}${cqt}") for @tables_preserve_case_tests; + my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1); - $dbh->disconnect; + $dbh->do("DROP TABLE ${oqt}${_}${cqt}") for @tables_preserve_case_tests; -# fixup for Firebird - $dbh = $self->dbconnect(0); - $dbh->do('DROP TABLE loader_test2'); - $dbh->disconnect; + $dbh->disconnect; + } } sub _custom_column_info { @@ -1770,8 +1759,9 @@ sub _custom_column_info { } my %DATA_TYPE_MULTI_TABLE_OVERRIDES = ( - oracle => qr/\blong\b/, - mssql => qr/\b(?:timestamp|rowversion)\b/, + oracle => qr/\blong\b/i, + mssql => qr/\b(?:timestamp|rowversion)\b/i, + informix => qr/\b(?:bigserial|serial8)\b/i, ); sub setup_data_type_tests { @@ -1784,11 +1774,11 @@ sub setup_data_type_tests { # split types into tables based on overrides my (@types, @split_off_types, @first_table_types); { - no warnings 'uninitialized'; + my $split_off_re = $DATA_TYPE_MULTI_TABLE_OVERRIDES{lc($self->{vendor})} || qr/(?!)/; @types = keys %$types; - @split_off_types = grep /$DATA_TYPE_MULTI_TABLE_OVERRIDES{lc($self->{vendor})}/i, @types; - @first_table_types = grep !/$DATA_TYPE_MULTI_TABLE_OVERRIDES{lc($self->{vendor})}/i, @types; + @split_off_types = grep /$split_off_re/, @types; + @first_table_types = grep !/$split_off_re/, @types; } @types = +{ map +($_, $types->{$_}), @first_table_types }, @@ -1821,7 +1811,7 @@ sub setup_data_type_tests { my @size = split /,/, $size; # some DBs don't like very long column names - if ($self->{vendor} =~ /^(?:firebird|sqlanywhere|oracle)\z/i) { + if ($self->{vendor} =~ /^(?:firebird|sqlanywhere|oracle|db2)\z/i) { my ($col_def, $default) = $type_alias =~ /^(.*)(default.*)?\z/i; $type_alias = substr $col_def, 0, 15; @@ -1862,11 +1852,18 @@ 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 DESTROY { my $self = shift; unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) { - $self->drop_tables if $self->{_created}; - rmtree $DUMP_DIR + $self->drop_tables if $self->{_created}; + rmtree $DUMP_DIR } }