Another attempt at backcompat tests for the dev version of DBIx::Class::Schema::Loader
|
|
Zbigniew Lukasiak
|
OK - so after some more IRC guidance I changed the backcompat tests
according to the idea that the backcompat should be loaded automatically. I hope this time it can go into the svn repository. I did not modify the backcompat layer itself beside fixing one typo and adding some POD, I only added tests to the existing code by Ilmari. The diff against http://dev.catalyst.perl.org/repos/bast/branches/DBIx-Class-Schema-Loader/back-compat is attached. Cheers, -- Zbigniew Lukasiak http://brudnopis.blogspot.com/ http://perlalchemy.blogspot.com/ [backcompat2.diff] Index: t/lib/dbixcsl_backcompat.pm =================================================================== --- t/lib/dbixcsl_backcompat.pm (revision 0) +++ t/lib/dbixcsl_backcompat.pm (revision 0) @@ -0,0 +1,78 @@ +package dbixcsl_backcompat; + +use strict; +use warnings; + +use Test::More; +use parent 'dbixcsl_common_tests'; +use File::Path qw(make_path remove_tree); +use File::Spec; + +sub clean_dump_dir { + my $self = shift; + remove_tree($self->DUMP_DIR, 1, 1); + my $dir = File::Spec->catdir( $self->DUMP_DIR, 'DBIXCSL_Test'); + make_path( $dir ); + my $path = File::Spec->catfile( $dir, 'Schema.pm' ); + open(my $fh, '>', $path) or die $!; + my $schema_content = <<END; +package DBIXCSL_Test::Schema; + +use strict; +use warnings; + +use base 'DBIx::Class::Schema'; + +__PACKAGE__->load_classes; + + +# Created by DBIx::Class::Schema::Loader v0.04006 @ 2009-10-23 21:51:42 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:pZwPLSUEY4GMt6SrwicyMA + + +# You can replace this text with custom content, and it will be preserved on regeneration +1; +END + print $fh $schema_content; +} + +sub num_of_tests { + my $self = shift; + return 3 + 7; +} + +sub test_schema { + my $self = shift; + my $schema_class = shift; + + 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; + $monikers->{$table_name} = $source_name; + $classes->{$table_name} = $schema_class . q{::} . $source_name; + } + + is($monikers->{loader_test1s}, 'LoaderTest1s', 'moniker singularisation'); + + my $obj6 = $conn->resultset($monikers->{loader_test6})->find(1); + isa_ok( $obj6->loader_test2_id, $classes->{loader_test2} ); + ok($classes->{loader_test6}->column_info('loader_test2_id')->{is_foreign_key}, 'Foreign key detected'); + + # test one-to-one rels + my $rsobj27 = $conn->resultset($monikers->{loader_test27}); + my $obj27 = $rsobj27->find(1); + my $obj28 = $obj27->loader_test28s->first; + isa_ok($obj28, $classes->{loader_test28}); + + my $obj29 = $obj27->loader_test29s->first; + isa_ok($obj29, $classes->{loader_test29}); + + $obj27 = $rsobj27->find(2); + is($obj27->loader_test28s->first, undef, "Undef for missing one-to-one row"); + is($obj27->loader_test29s->first, undef, "Undef for missing one-to-one row"); +} + +1; + Index: t/lib/dbixcsl_common_tests.pm =================================================================== --- t/lib/dbixcsl_common_tests.pm (revision 7767) +++ t/lib/dbixcsl_common_tests.pm (working copy) @@ -9,9 +9,13 @@ use File::Path; use DBI; -my $DUMP_DIR = './t/_common_dump'; -rmtree $DUMP_DIR; +sub DUMP_DIR { './t/_common_dump' }; +sub clean_dump_dir { + my $self = shift; + rmtree $self->DUMP_DIR; +} + sub new { my $class = shift; @@ -33,7 +37,9 @@ # Optional extra tables and tests $self->{extra} ||= {}; - return bless $self => $class; + bless $self => $class; + $self->clean_dump_dir(); + return $self; } sub skip_tests { @@ -48,10 +54,15 @@ return undef; } +sub num_of_tests { + my $self = shift; + return 3 + 134 + ($self->{extra}->{count} || 0); +} + sub run_tests { my $self = shift; - plan tests => 3 + 134 + ($self->{extra}->{count} || 0); + plan tests => $self->num_of_tests; $self->create(); @@ -83,7 +94,7 @@ inflect_singular => { fkid => 'fkid_singular' }, moniker_map => \&_monikerize, debug => $debug, - dump_directory => $DUMP_DIR, + dump_directory => $self->DUMP_DIR, ); $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema}; @@ -1185,7 +1196,7 @@ sub DESTROY { my $self = shift; $self->drop_tables if $self->{_created}; - rmtree $DUMP_DIR; + rmtree $self->DUMP_DIR; } 1; Index: t/30backcompat.t =================================================================== --- t/30backcompat.t (revision 0) +++ t/30backcompat.t (revision 0) @@ -0,0 +1,24 @@ +use strict; +use lib qw(t/lib); +use dbixcsl_backcompat; +use File::Path; +use File::Copy::Recursive 'dircopy'; + +eval { require DBD::SQLite }; +my $class = $@ ? 'SQLite2' : 'SQLite'; + +{ + my $tester = dbixcsl_backcompat->new( + vendor => 'SQLite', + auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT', + dsn => "dbi:$class:dbname=./t/sqlite_test", + user => '', + password => '', + ); + + $tester->run_tests(); +} + +END { + unlink './t/sqlite_test'; +} Index: lib/DBIx/Class/Schema/Loader/Compat/v0_040.pm =================================================================== --- lib/DBIx/Class/Schema/Loader/Compat/v0_040.pm (revision 7767) +++ lib/DBIx/Class/Schema/Loader/Compat/v0_040.pm (working copy) @@ -14,9 +14,25 @@ sub _relbuilder { my ($self) = @_; - $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder::v04Compat->new( + $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040->new( $self->schema, $self->inflect_plural, $self->inflect_singular ); } 1; + +=head1 NAME + +DBIx::Class::Schema::Loader::Compat::v0_040 - backcompatibility layer + +=head1 SYNOPSIS + +See L<DBIx::Class::Schema::Loader> + +=head1 DESCRIPTION + +This is an additional base class for DBIx::Class::Schema::Loader loaded automatically +when dumping into existing schema files from versions 0.04x + + + Index: lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm =================================================================== --- lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm (revision 7767) +++ lib/DBIx/Class/Schema/Loader/RelBuilder/Compat/v0_040.pm (working copy) @@ -32,3 +32,17 @@ 1; + +=head1 NAME + +DBIx::Class::Schema::Loader::Compat::v0_040 - backcompatibility layer + +=head1 SYNOPSIS + +See L<DBIx::Class::Schema::Loader> + +=head1 DESCRIPTION + +This is an additional base class for DBIx::Class::Schema::Loader loaded automatically +when dumping into existing schema files from versions 0.04x + _______________________________________________ List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class IRC: irc.perl.org#dbix-class SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/ Searchable Archive: http://www.grokbase.com/group/dbix-class@... |
||||||||||||||||
| Free Embeddable Forum Powered by Nabble | Help |
