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=782d9855ca6ae3813c649d88f8942cbf5967a8b7;hpb=dd87d4c4612dbc0120da1e1826cb3f09c15fbcdb;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index 782d985..f8ce130 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -12,12 +12,19 @@ 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 Try::Tiny; +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 +49,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"; @@ -88,7 +95,14 @@ sub run_tests { my $extra_count = $self->{extra}{count} || 0; - plan tests => @connect_info * (178 + $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]; @@ -120,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; @@ -155,11 +168,14 @@ 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} || [] }; - 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"); + } } } @@ -175,15 +191,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/ ], + components => [ qw/TestComponent +TestComponentFQN/ ], inflect_plural => { loader_test4 => 'loader_test4zes' }, inflect_singular => { fkid => 'fkid_singular' }, moniker_map => \&_monikerize, @@ -193,6 +218,9 @@ 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' }, + column_accessor_map => \&test_column_accessor_map, %{ $self->{loader_options} || {} }, ); @@ -203,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/; @@ -220,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} || [] }; @@ -238,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; @@ -246,6 +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: { @@ -271,7 +307,7 @@ sub setup_schema { } } - exit if $file_count != $expected_count; + exit if ($file_count||0) != $expected_count; return $schema_class; } @@ -315,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/ ], "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'; @@ -323,6 +362,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) { @@ -381,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' ) @@ -395,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); @@ -432,11 +463,21 @@ sub test_schema { 'constant integer default', ); + is( + $class35->column_info('a_negative_int')->{default_value}, -42, + 'constant negative integer default', + ); + cmp_ok( $class35->column_info('a_double')->{default_value}, '==', 10.555, 'constant numeric default', ); + cmp_ok( + $class35->column_info('a_negative_double')->{default_value}, '==', -10.555, + 'constant negative numeric default', + ); + my $function_default = $class35->column_info('a_function')->{default_value}; isa_ok( $function_default, 'SCALAR', 'default_value for function default' ); @@ -579,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"); @@ -608,8 +652,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'); @@ -633,12 +677,14 @@ sub test_schema { 'might_have does not have is_deferrable'); # find on multi-col pk - my $obj5 = - eval { $rsobj5->find({id1 => 1, iD2 => 1}) } || - eval { $rsobj5->find({id1 => 1, id2 => 1}) }; - die $@ if $@; - - is( (eval { $obj5->id2 } || eval { $obj5->i_d2 }), 1, "Find on multi-col PK" ); + if ($conn->_loader->preserve_case) { + my $obj5 = $rsobj5->find({id1 => 1, iD2 => 1}); + is $obj5->i_d2, 1, 'Find on multi-col PK'; + } + else { + my $obj5 = $rsobj5->find({id1 => 1, id2 => 1}); + is $obj5->id2, 1, 'Find on multi-col PK'; + } # mulit-col fk def my $obj6 = $rsobj6->find(1); @@ -797,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}; @@ -822,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: { @@ -883,7 +950,7 @@ sub test_schema { my $find_cb = sub { return if -d; - return if $_ eq 'LoaderTest30.pm'; + return if /^(?:LoaderTest30|LoaderTest1|LoaderTest2X)\.pm\z/; open my $fh, '<', $_ or die "Could not open $_ for reading: $!"; binmode $fh; @@ -892,35 +959,27 @@ sub test_schema { find $find_cb, $DUMP_DIR; - my $before_digest = $digest->digest; +# system "rm -f /tmp/before_rescan/* /tmp/after_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"; + $digest = Digest::MD5->new; find $find_cb, $DUMP_DIR; - my $after_digest = $digest->digest; + my $after_digest = $digest->b64digest; is $before_digest, $after_digest, 'dumped files are not rewritten when there is no modification'; @@ -941,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') } @@ -955,7 +1012,9 @@ 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); $self->drop_tables unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}; @@ -965,39 +1024,76 @@ 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; + } - foreach my $moniker (@{ $data_type_tests->{table_monikers} }) { - my $columns = $data_type_tests->{columns}{$moniker}; + my $data_type_tests = $self->{data_type_tests}; - my $rsrc = $conn->resultset($moniker)->result_source; + foreach my $moniker (@{ $data_type_tests->{table_monikers} }) { + my $columns = $data_type_tests->{columns}{$moniker}; - while (my ($col_name, $expected_info) = each %$columns) { - my %info = %{ $rsrc->column_info($col_name) }; - delete @info{qw/is_nullable timezone locale sequence/}; + my $rsrc = $conn->resultset($moniker)->result_source; - my $text_col_def = do { - my $dd = Dumper; - $dd->Indent(0); - $dd->Values([\%info]); - $dd->Dump; - }; + 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_expected_info = do { - my $dd = Dumper; - $dd->Indent(0); - $dd->Values([$expected_info]); - $dd->Dump; - }; + my $text_col_def = dumper_squashed \%info; - is_deeply \%info, $expected_info, - "test column $col_name has definition: $text_col_def expecting: $text_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"; + } } } } } +sub test_preserve_case { + my ($self, $conn) = @_; + + my ($oqt, $cqt) = $self->get_oqt_cqt(always => 1); # open quote, close quote + + my $dbh = $self->dbconnect; + + $dbh->do($_) for ( +qq| + CREATE TABLE ${oqt}LoaderTest40${cqt} ( + ${oqt}Id${cqt} INTEGER NOT NULL PRIMARY KEY, + ${oqt}Foo3Bar${cqt} VARCHAR(100) NOT NULL + ) $self->{innodb} +|, +qq| + CREATE TABLE ${oqt}LoaderTest41${cqt} ( + ${oqt}Id${cqt} INTEGER NOT NULL PRIMARY KEY, + ${oqt}LoaderTest40Id${cqt} INTEGER, + FOREIGN KEY (${oqt}LoaderTest40Id${cqt}) REFERENCES ${oqt}LoaderTest40${cqt} (${oqt}Id${cqt}) + ) $self->{innodb} +|, +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; + + $self->rescan_without_warnings($conn); + + if (not $self->{skip_rels}) { + is $conn->resultset('LoaderTest41')->find(1)->loader_test40->foo3_bar, 'foo', + 'rel and accessor for mixed-case column name in mixed case table'; + } + else { + is $conn->resultset('LoaderTest40')->find(1)->foo3_bar, 'foo', + 'accessor for mixed-case column name in mixed case table'; + } +} + sub monikers_and_classes { my ($self, $schema_class) = @_; my ($monikers, $classes); @@ -1058,11 +1154,33 @@ sub dbconnect { return $dbh; } +sub get_oqt_cqt { + my $self = shift; + my %opts = @_; + + if ((not $opts{always}) && $self->{preserve_case_mode_is_exclusive}) { + return ('', ''); + } + + # XXX should get quote_char from the storage of an initialized loader. + my ($oqt, $cqt); # open quote, close quote + if (ref $self->{quote_char}) { + ($oqt, $cqt) = @{ $self->{quote_char} }; + } + else { + $oqt = $cqt = $self->{quote_char} || ''; + } + + return ($oqt, $cqt); +} + sub create { my $self = shift; $self->{_created} = 1; + $self->drop_tables; + my $make_auto_inc = $self->{auto_inc_cb} || sub {}; @statements = ( qq{ @@ -1084,7 +1202,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} }, @@ -1114,7 +1234,9 @@ sub create { id INTEGER NOT NULL PRIMARY KEY, a_varchar VARCHAR(100) DEFAULT 'foo', an_int INTEGER DEFAULT 42, + a_negative_int INTEGER DEFAULT -42, a_double DOUBLE PRECISION DEFAULT 10.555, + a_negative_double DOUBLE PRECISION DEFAULT -10.555, a_function $self->{default_function_def} ) $self->{innodb} }, @@ -1122,13 +1244,16 @@ 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} }, ); + # some DBs require mixed case identifiers to be quoted + my ($oqt, $cqt) = $self->get_oqt_cqt; + @statements_reltests = ( qq{ CREATE TABLE loader_test3 ( @@ -1147,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} }, @@ -1156,33 +1282,33 @@ sub create { q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc') }, q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd') }, - qq{ + qq| CREATE TABLE loader_test5 ( id1 INTEGER NOT NULL, - iD2 INTEGER NOT NULL, + ${oqt}iD2${cqt} INTEGER NOT NULL, dat VARCHAR(8), from_id INTEGER $self->{null}, to_id INTEGER $self->{null}, - PRIMARY KEY (id1,iD2), + PRIMARY KEY (id1,${oqt}iD2${cqt}), FOREIGN KEY (from_id) REFERENCES loader_test4 (id), FOREIGN KEY (to_id) REFERENCES loader_test4 (id) ) $self->{innodb} - }, + |, - q{ INSERT INTO loader_test5 (id1,iD2,dat) VALUES (1,1,'aaa') }, + qq| INSERT INTO loader_test5 (id1,${oqt}iD2${cqt},dat) VALUES (1,1,'aaa') |, - qq{ + qq| CREATE TABLE loader_test6 ( id INTEGER NOT NULL PRIMARY KEY, - Id2 INTEGER, + ${oqt}Id2${cqt} INTEGER, loader_test2_id INTEGER, dat VARCHAR(8), FOREIGN KEY (loader_test2_id) REFERENCES loader_test2 (id), - FOREIGN KEY(id,Id2) REFERENCES loader_test5 (id1,iD2) + FOREIGN KEY(id,${oqt}Id2${cqt}) REFERENCES loader_test5 (id1,${oqt}iD2${cqt}) ) $self->{innodb} - }, + |, - (q{ INSERT INTO loader_test6 (id, Id2,loader_test2_id,dat) } . + (qq| INSERT INTO loader_test6 (id, ${oqt}Id2${cqt},loader_test2_id,dat) | . q{ VALUES (1, 1,1,'aaa') }), qq{ @@ -1493,19 +1619,16 @@ 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); - $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 @@ -1534,6 +1657,7 @@ sub drop_tables { my $self = shift; my @tables = qw/ + loader_test1 loader_test1s loader_test2 LOADER_test23 @@ -1595,50 +1719,59 @@ sub drop_tables { my @tables_rescan = qw/ loader_test30 /; + my @tables_preserve_case_tests = qw/ LoaderTest41 LoaderTest40 /; + my $drop_fk_mysql = q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk}; 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}) { - $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); + my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {}; - unless($self->{no_inline_rels}) { - $dbh->do("DROP TABLE $_") for (@tables_inline_rels); + 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_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); + + 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"); + } } - } - $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"); - } + 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 { @@ -1665,8 +1798,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 { @@ -1679,11 +1813,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 }, @@ -1716,7 +1850,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; @@ -1757,11 +1891,32 @@ 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}) { - $self->drop_tables if $self->{_created}; - rmtree $DUMP_DIR + $self->drop_tables if $self->{_created}; + rmtree $DUMP_DIR } }