X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fbackcompat%2F0.04006%2Flib%2Fdbixcsl_common_tests.pm;h=c29ed4e4c211ecf5a1956fddf3873ca67cbe716f;hb=9ff235d2b5c3ae8d08097744344bce8f119e709b;hp=ada0338c49fdc396f5669cbe404688f702585491;hpb=9a95164df15467a6f94d3d74e8f3b508b6607e23;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm b/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm index ada0338..c29ed4e 100644 --- a/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm +++ b/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm @@ -43,7 +43,7 @@ sub _monikerize { sub run_tests { my $self = shift; - plan tests => 88; + plan tests => 97; $self->create(); @@ -66,13 +66,6 @@ sub run_tests { ); $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema}; - eval { require Class::Inspector }; - if($@) { - $self->{_no_rs_components} = 1; - } - else { - $loader_opts{resultset_components} = [ qw/TestRSComponent/ ]; - } { my @loader_warnings; @@ -88,31 +81,37 @@ sub run_tests { my $warn_count = 0; $warn_count++ if grep /ResultSetManager/, @loader_warnings; + $warn_count++ if grep /Dynamic schema detected/, @loader_warnings; + $warn_count++ for grep /^Bad table or view/, @loader_warnings; - if($self->{skip_rels}) { - is(scalar(@loader_warnings), $warn_count) - or diag "Did not get the expected 0 warnings. Warnings are: " - . join('',@loader_warnings); - ok(1); - } - else { - $warn_count++; - is(scalar(@loader_warnings), $warn_count) - or diag "Did not get the expected 1 warning. Warnings are: " - . join('',@loader_warnings); - is(grep(/loader_test9 has no primary key/, @loader_warnings), 1); - } + is(scalar(@loader_warnings), $warn_count) + or diag "Did not get the expected 0 warnings. Warnings are: " + . join('',@loader_warnings); } my $conn = $schema_class->clone; my $monikers = {}; my $classes = {}; foreach my $source_name ($schema_class->sources) { - my $table_name = $schema_class->source($source_name)->from; + my $table_name = $schema_class->loader->moniker_to_table->{$source_name}; + + my $result_class = $schema_class->source($source_name)->result_class; + $monikers->{$table_name} = $source_name; - $classes->{$table_name} = $schema_class . q{::} . $source_name; + $classes->{$table_name} = $result_class; + + # some DBs (Firebird, Oracle) uppercase everything + $monikers->{lc $table_name} = $source_name; + $classes->{lc $table_name} = $result_class; } +# for debugging... +# { +# mkdir '/tmp/HLAGH'; +# $conn->_loader->{dump_directory} = '/tmp/HLAGH'; +# $conn->_loader->_dump_to_dir(values %$classes); +# } + my $moniker1 = $monikers->{loader_test1}; my $class1 = $classes->{loader_test1}; my $rsobj1 = $conn->resultset($moniker1); @@ -167,7 +166,7 @@ sub run_tests { { my ($skip_tab, $skip_tabo, $skip_taba, $skip_cmeth, - $skip_rsmeth, $skip_tcomp, $skip_trscomp); + $skip_tcomp, $skip_trscomp); can_ok( $class1, 'test_additional_base' ) or $skip_tab = 1; can_ok( $class1, 'test_additional_base_override' ) or $skip_tabo = 1; @@ -175,11 +174,6 @@ sub run_tests { can_ok( $class1, 'dbix_class_testcomponent' ) or $skip_tcomp = 1; can_ok( $class1, 'loader_test1_classmeth' ) or $skip_cmeth = 1; - TODO: { - local $TODO = "Not yet supported by ResultSetManger code"; - can_ok( $rsobj1, 'loader_test1_rsmeth' ) or $skip_rsmeth = 1; - } - SKIP: { skip "Pre-requisite test failed", 1 if $skip_tab; is( $class1->test_additional_base, "test_additional_base", @@ -206,26 +200,9 @@ sub run_tests { } SKIP: { - skip "These two tests need Class::Inspector installed", 2 - if $self->{_no_rs_components}; - can_ok($rsobj1, 'dbix_class_testrscomponent') or $skip_trscomp = 1; - SKIP: { - skip "Pre-requisite test failed", 1 if $skip_trscomp; - is( $rsobj1->dbix_class_testrscomponent, - 'dbix_class_testrscomponent works' ); - } - } - - SKIP: { skip "Pre-requisite test failed", 1 if $skip_cmeth; is( $class1->loader_test1_classmeth, 'all is well' ); } - - # XXX put this back in when the TODO above works... - #SKIP: { - # skip "Pre-requisite test failed", 1 if $skip_rsmeth; - # is( $rsobj1->loader_test1_rsmeth, 'all is still well' ); - #} } @@ -249,7 +226,7 @@ sub run_tests { is( $obj2->id, 2 ); SKIP: { - skip $self->{skip_rels}, 50 if $self->{skip_rels}; + skip $self->{skip_rels}, 63 if $self->{skip_rels}; my $moniker3 = $monikers->{loader_test3}; my $class3 = $classes->{loader_test3}; @@ -340,6 +317,45 @@ sub run_tests { my $rs_rel4 = $obj3->search_related('loader_test4zes'); isa_ok( $rs_rel4->first, $class4); + # test that _id is not stripped and prepositions in rel names are + # ignored + ok ($rsobj4->result_source->has_relationship('loader_test5_to_ids'), + "rel with preposition 'to' and _id pluralized backward-compatibly"); + + ok ($rsobj4->result_source->has_relationship('loader_test5_from_ids'), + "rel with preposition 'from' and _id pluralized backward-compatibly"); + + # check that default relationship attributes are not applied in 0.04006 mode + is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_delete}, 1, + 'cascade_delete => 1 on has_many by default'; + + is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_copy}, 1, + 'cascade_copy => 1 on has_many by default'; + + ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{on_delete}), + 'has_many does not have on_delete'); + + ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{on_update}), + 'has_many does not have on_update'); + + ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{is_deferrable}), + 'has_many does not have is_deferrable'); + + isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_delete}, 'CASCADE', + "on_delete => 'CASCADE' not on belongs_to by default"; + + isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_update}, 'CASCADE', + "on_update => 'CASCADE' not on belongs_to by default"; + + isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{is_deferrable}, 1, + "is_deferrable => 1 not 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'); + + ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_copy}), + 'belongs_to does not have cascade_copy'); + # find on multi-col pk my $obj5 = $rsobj5->find({id1 => 1, id2 => 1}); is( $obj5->id2, 1 ); @@ -420,7 +436,11 @@ sub run_tests { $obj10_2->loader_test11( $obj11->id11() ); $obj10_2->update(); }; - is($@, '', 'No errors after eval{}'); + is($@, '', 'No errors after eval{}') + or do { + diag explain $rsobj10->result_source->relationship_info('loader_test11'); + diag explain $rsobj11->result_source->relationship_info('loader_test10'); + }; SKIP: { skip 'Previous eval block failed', 3 @@ -438,7 +458,7 @@ sub run_tests { } SKIP: { - skip 'This vendor cannot do inline relationship definitions', 5 + skip 'This vendor cannot do inline relationship definitions', 6 if $self->{no_inline_rels}; my $moniker12 = $monikers->{loader_test12}; @@ -456,6 +476,9 @@ sub run_tests { isa_ok( $obj13->id, $class12 ); isa_ok( $obj13->loader_test12, $class12); isa_ok( $obj13->dat, $class12); + + my $obj12 = $rsobj12->find(1); + isa_ok( $obj12->loader_test13_ids, "DBIx::Class::ResultSet" ); } SKIP: { @@ -493,11 +516,16 @@ sub run_tests { q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(321, 2) }, ); - my $dbh = $self->dbconnect(1); - $dbh->do($_) for @statements_rescan; - $dbh->disconnect; + { + my $dbh = $self->dbconnect(1); + $dbh->do($_) for @statements_rescan; + $dbh->disconnect; + } - my @new = $conn->rescan; + my @new = do { + local $SIG{__WARN__} = sub {}; + $conn->rescan; + }; is(scalar(@new), 1); is($new[0], 'LoaderTest30'); @@ -520,6 +548,12 @@ sub dbconnect { AutoCommit => 1, } ); + if ($self->{dsn} =~ /^[^:]+:SQLite:/) { + $dbh->do ('PRAGMA synchronous = OFF'); + } + elsif ($self->{dsn} =~ /^[^:]+:Pg:/) { + $dbh->do ('SET client_min_messages=WARNING'); + } die "Failed to connect to database: $DBI::errstr" if !$dbh; @@ -607,7 +641,11 @@ sub create { id1 INTEGER NOT NULL, iD2 INTEGER NOT NULL, dat VARCHAR(8), - PRIMARY KEY (id1,id2) + from_id INTEGER, + to_id INTEGER, + PRIMARY KEY (id1,id2), + FOREIGN KEY (from_id) REFERENCES loader_test4 (id), + FOREIGN KEY (to_id) REFERENCES loader_test4 (id) ) $self->{innodb} }, @@ -842,12 +880,6 @@ sub create { my $dbh = $self->dbconnect(1); - # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." - local $SIG{__WARN__} = sub { - my $msg = shift; - print STDERR $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; - }; - $dbh->do($_) for (@statements); unless($self->{skip_rels}) { # hack for now, since DB2 doesn't like inline comments, and we need