X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2Fdbixcsl_common_tests.pm;h=49137d60d2d06d360f880372e7b4e389535bad7e;hb=aa0867ee7faa8246a6552861b61bea59c6483487;hp=62a4f6861bed161f882e7a2580253714ea82ba06;hpb=b511f36e7550cfe8aac546be689c8bd320a83975;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index 62a4f68..49137d6 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -14,6 +14,8 @@ use File::Find 'find'; use Class::Unload (); use Data::Dumper::Concise; use List::MoreUtils 'apply'; +use DBIx::Class::Schema::Loader::Optional::Dependencies (); +use namespace::clean; my $DUMP_DIR = './t/_common_dump'; rmtree $DUMP_DIR; @@ -88,7 +90,7 @@ sub run_tests { my $extra_count = $self->{extra}{count} || 0; - plan tests => @connect_info * (179 + $extra_count + ($self->{data_type_tests}{test_count} || 0)); + plan tests => @connect_info * (182 + $extra_count + ($self->{data_type_tests}{test_count} || 0)); foreach my $info_idx (0..$#connect_info) { my $info = $connect_info[$info_idx]; @@ -155,7 +157,12 @@ sub drop_extra_tables_only { my $self = shift; my $dbh = $self->dbconnect(0); - $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; + + { + local $SIG{__WARN__} = sub {}; # postgres notices + $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} || [] }) { @@ -175,6 +182,8 @@ sub setup_schema { my $debug = ($self->{verbose} > 1) ? 1 : 0; + my $use_moose = DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose'); + my %loader_opts = ( constraint => qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)_?)?loader_?test[0-9]+(?!.*_)/i, @@ -193,6 +202,7 @@ sub setup_schema { dump_directory => $DUMP_DIR, datetime_timezone => 'Europe/Berlin', datetime_locale => 'de_DE', + use_moose => $use_moose, %{ $self->{loader_options} || {} }, ); @@ -317,7 +327,7 @@ 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 dbix_class_testcomponent meta/ ], "Column Ordering" ); is $class2->column_info('set_primary_key')->{accessor}, undef, 'accessor for column name that conflicts with a result base class method removed'; @@ -325,6 +335,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) { @@ -434,11 +447,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' ); @@ -610,8 +633,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'); @@ -899,7 +922,7 @@ sub test_schema { # system "rm -f /tmp/before_rescan/* /tmp/after_rescan/*"; # system "cp t/_common_dump/DBIXCSL_Test/Schema/*.pm /tmp/before_rescan"; - my $before_digest = $digest->digest; + my $before_digest = $digest->b64digest; $conn->storage->disconnect; # needed for Firebird and Informix my $dbh = $self->dbconnect(1); @@ -929,7 +952,7 @@ sub test_schema { $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'; @@ -1168,6 +1191,7 @@ sub create { dat2 VARCHAR(32) NOT NULL, set_primary_key INTEGER $self->{null}, dbix_class_testcomponent INTEGER $self->{null}, + meta INTEGER $self->{null}, UNIQUE (dat2, dat) ) $self->{innodb} }, @@ -1197,7 +1221,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} }, @@ -1691,7 +1717,11 @@ sub drop_tables { my $dbh = $self->dbconnect(0); - $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; + { + local $SIG{__WARN__} = sub {}; # postgres notices + $dbh->do($_) for @{ $self->{extra}{pre_drop_ddl} || [] }; + } + $dbh->do("DROP TABLE $_") for @{ $self->{extra}{drop} || [] }; my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {}; @@ -1758,8 +1788,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 { @@ -1772,11 +1803,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 },