From: Dan Kubb Date: Sat, 13 Aug 2005 18:01:48 +0000 (+0000) Subject: Catch or silence all warnings in test cases X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c461d5d37454beba1df38a299c0656419c1af623;p=dbsrgits%2FDBIx-Class-Historic.git Catch or silence all warnings in test cases Added Test::NoWarnings to make sure warnings in the future cause a test failure Integrated fields with Inflation code Moved use_ok/require statements in test cases into BEGIN block. Class::Std needs to be run from a BEGIN block only. Removed redundant methods from Validate libraries. Further simplification of API is warranted. Removed RESTRICTIVE attribute from methods in Validate/Field libraries. Impossible for sibling classes to access methods, only parent or child. --- diff --git a/Build.PL b/Build.PL index a3b570b..446dd93 100644 --- a/Build.PL +++ b/Build.PL @@ -11,6 +11,7 @@ my %arguments = ( 'Test::NoWarnings' => '0.08', 'Test::Manifest' => '1.11', 'Test::More' => '0.60', + 'Test::Warn' => '0.08', }, requires => { 'Data::Page' => 0, diff --git a/lib/DBIx/Class/Core.pm b/lib/DBIx/Class/Core.pm index 5dc4096..745ea72 100644 --- a/lib/DBIx/Class/Core.pm +++ b/lib/DBIx/Class/Core.pm @@ -6,14 +6,25 @@ no warnings 'qw'; use base qw/DBIx::Class/; -__PACKAGE__->load_components(qw/ - InflateColumn - Relationship - PK - Row - Table - Exception - AccessorGroup/); +BEGIN { + __PACKAGE__->load_components(qw/ + InflateColumn + Relationship + PK + Row + Validation + Table + Exception + AccessorGroup + /); + + __PACKAGE__->load_types(qw/ + column + number + object + string + /); +} 1; diff --git a/lib/DBIx/Class/InflateColumn.pm b/lib/DBIx/Class/InflateColumn.pm index 5c7f914..ba5b12f 100644 --- a/lib/DBIx/Class/InflateColumn.pm +++ b/lib/DBIx/Class/InflateColumn.pm @@ -2,43 +2,48 @@ package DBIx::Class::InflateColumn; use strict; use warnings; +use Carp qw( croak ); sub inflate_column { my ($self, $col, $attrs) = @_; - die "No such column $col to inflate" unless exists $self->_columns->{$col}; - die "inflate_column needs attr hashref" unless ref $attrs eq 'HASH'; - $self->_columns->{$col}{_inflate_info} = $attrs; - $self->mk_group_accessors('inflated_column' => $col); + + $self->throw("inflate_column needs attr hashref") + unless ref $attrs eq 'HASH'; + + $self->throw("No such column $col to inflate") + unless exists $self->_columns->{$col}{field}; + + $self->_columns->{$col}{field}->set_inflate($attrs->{inflate}); + $self->_columns->{$col}{field}->set_deflate($attrs->{deflate}); + + $self->mk_group_accessors(inflated_column => $col); + return 1; } sub _inflated_column { my ($self, $col, $value) = @_; return $value unless defined $value; # NULL is NULL is NULL - return $value unless exists $self->_columns->{$col}{_inflate_info}; - return $value unless exists $self->_columns->{$col}{_inflate_info}{inflate}; - my $inflate = $self->_columns->{$col}{_inflate_info}{inflate}; + return $value unless my $inflate = $self->_columns->{$col}{field}->get_inflate; return $inflate->($value, $self); } sub _deflated_column { my ($self, $col, $value) = @_; return $value unless ref $value; # If it's not an object, don't touch it - return $value unless exists $self->_columns->{$col}{_inflate_info}; - return $value unless exists $self->_columns->{$col}{_inflate_info}{deflate}; - my $deflate = $self->_columns->{$col}{_inflate_info}{deflate}; + return $value unless my $deflate = $self->_columns->{$col}{field}->get_deflate; return $deflate->($value, $self); } sub get_inflated_column { my ($self, $col) = @_; $self->throw("$col is not an inflated column") unless - exists $self->_columns->{$col}{_inflate_info}; + defined $self->_columns->{$col}{field}->get_inflate; return $self->{_inflated_column}{$col} if exists $self->{_inflated_column}{$col}; return $self->{_inflated_column}{$col} = - $self->_inflated_column($col, $self->get_column($col)); + $self->_inflated_column($col, $self->get_column($col)); } sub set_inflated_column { @@ -56,7 +61,7 @@ sub store_inflated_column { } my $deflated = $self->_deflated_column($col, $obj); - # Do this now so we don't store if it's invalid + # Do this now so we don't store if it's invalid $self->{_inflated_column}{$col} = $obj; #warn "Storing $obj: ".($obj->_ident_values)[0]; @@ -69,10 +74,9 @@ sub new { $attrs ||= {}; my %deflated; foreach my $key (keys %$attrs) { - if (exists $class->_columns->{$key}{_inflate_info}) { - $deflated{$key} = $class->_deflated_column($key, - delete $attrs->{$key}); - } + next unless defined $class->_columns->{$key}{field} + and defined $class->_columns->{$key}{field}->get_deflate; + $deflated{$key} = $class->_deflated_column($key, delete $attrs->{$key}); } return $class->NEXT::ACTUAL::new({ %$attrs, %deflated }, @rest); } diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm index 42631de..2ed5fd6 100644 --- a/lib/DBIx/Class/Table.pm +++ b/lib/DBIx/Class/Table.pm @@ -39,7 +39,12 @@ sub _register_columns { my ($class, @cols) = @_; my $names = { %{$class->_columns} }; $names->{$_} ||= {} for @cols; - $class->_columns($names); + $class->_columns($names); + + foreach my $name (@cols) { + $class->set_field_column_name($name => $name); + $class->_columns->{$name}{field} = $class->get_field($name); + } } sub _mk_column_accessors { @@ -145,7 +150,9 @@ sub search_like { } sub _select_columns { - return keys %{$_[0]->_columns}; + return + map { $_->{field}->get_name } + values %{$_[0]->_columns}; } =item table @@ -174,7 +181,11 @@ sub find_or_create { return defined($exists) ? $exists : $class->create($hash); } -sub columns { return keys %{shift->_columns}; } +sub columns { + return + map { $_->{field}->get_name } + values %{$_[0]->_columns}; +} 1; diff --git a/lib/DBIx/Class/Validation.pm b/lib/DBIx/Class/Validation.pm index 77bdfd4..7455046 100644 --- a/lib/DBIx/Class/Validation.pm +++ b/lib/DBIx/Class/Validation.pm @@ -21,7 +21,7 @@ use Class::Std; return; } - sub get_field : RESTRICTED method { + sub get_field : method { my ( $class, $field_name ) = @_; croak 'must supply a field name' @@ -47,23 +47,23 @@ use Class::Std; return $field_class->get_instance; } - sub set_field_label : RESTRICTED method { + sub set_field_label : method { return shift->get_field(shift)->set_label(shift); } - sub set_field_description : RESTRICTED method { + sub set_field_description : method { return shift->get_field(shift)->set_description(shift); } - sub set_field_default : RESTRICTED method { + sub set_field_default : method { return shift->get_field(shift)->set_default(shift); } - sub set_field_read_only : RESTRICTED method { + sub set_field_read_only : method { return shift->get_field(shift)->set_is_read_only(1); } - sub set_field : RESTRICTED method { + sub set_field : method { my ( $class, $field_name, $attr ) = @_; while ( my ( $attr, $value ) = each %{$attr} ) { @@ -74,7 +74,7 @@ use Class::Std; return; } - sub validates_presence_of : RESTRICTED method { + sub validates_presence_of : method { my ( $class, $field_name, $opt ) = @_; $class->get_field($field_name)->set_is_required(1); @@ -86,7 +86,7 @@ use Class::Std; return; } - sub validates_allowed_values_of : RESTRICTED method { + sub validates_allowed_values_of : method { my ( $class, $field_name, $allowed_values, $opt ) = @_; $class->get_field($field_name) @@ -99,7 +99,7 @@ use Class::Std; return; } - sub validates_disallowed_values_of : RESTRICTED method { + sub validates_disallowed_values_of : method { my ( $class, $field_name, $disallowed_values, $opt ) = @_; $class->get_field($field_name) @@ -112,7 +112,7 @@ use Class::Std; return; } - sub validates_each_with : RESTRICTED method { + sub validates_each_with : method { my ( $class, $field_name, $callbacks, $opt ) = @_; $class->get_field($field_name) diff --git a/lib/DBIx/Class/Validation/Type/column.pm b/lib/DBIx/Class/Validation/Type/column.pm index 3838d25..29a7233 100644 --- a/lib/DBIx/Class/Validation/Type/column.pm +++ b/lib/DBIx/Class/Validation/Type/column.pm @@ -2,12 +2,11 @@ package DBIx::Class::Validation::Type::column; use strict; use warnings FATAL => 'all'; -use base qw( DBIx::Class::Validation ); use Carp qw( croak ); use DBIx::Class::Field::Type::column; use Class::Std; { - sub set_field_column_name : RESTRICTED method { + sub set_field_column_name : method { my ( $class, $field_name, $column_name ) = @_; $class->_add_column_type_to_field($field_name); @@ -15,22 +14,6 @@ use Class::Std; return shift->get_field($field_name)->set_column_name($column_name); } - sub set_field_inflate : RESTRICTED method { - my ( $class, $field_name, $column_name ) = @_; - - $class->_add_column_type_to_field($field_name); - - return shift->get_field($field_name)->set_inflate($column_name); - } - - sub set_field_deflate : RESTRICTED method { - my ( $class, $field_name, $column_name ) = @_; - - $class->_add_column_type_to_field($field_name); - - return shift->get_field($field_name)->set_deflate($column_name); - } - sub _add_column_type_to_field : PRIVATE method { my ( $class, $field_name, $opt ) = @_; diff --git a/lib/DBIx/Class/Validation/Type/number.pm b/lib/DBIx/Class/Validation/Type/number.pm index eff29ce..0047528 100644 --- a/lib/DBIx/Class/Validation/Type/number.pm +++ b/lib/DBIx/Class/Validation/Type/number.pm @@ -2,12 +2,11 @@ package DBIx::Class::Validation::Type::number; use strict; use warnings FATAL => 'all'; -use base qw( DBIx::Class::Validation ); use Carp qw( croak ); use DBIx::Class::Field::Type::number; use Class::Std; { - sub validates_numericality_of : RESTRICTED method { + sub validates_numericality_of : method { my ( $class, $field_name, $opt ) = @_; my $field = $class->get_field($field_name); @@ -25,7 +24,7 @@ use Class::Std; return; } - sub validates_range_of : RESTRICTED method { + sub validates_range_of : method { my ( $class, $field_name, $opt ) = @_; $class->validates_numericality_of($field_name); @@ -47,7 +46,7 @@ use Class::Std; return; } - sub validates_precision_of : RESTRICTED method { + sub validates_precision_of : method { my ( $class, $field_name, $opt ) = @_; $class->validates_numericality_of($field_name); diff --git a/lib/DBIx/Class/Validation/Type/object.pm b/lib/DBIx/Class/Validation/Type/object.pm index 3d363f5..6bfd027 100644 --- a/lib/DBIx/Class/Validation/Type/object.pm +++ b/lib/DBIx/Class/Validation/Type/object.pm @@ -2,12 +2,11 @@ package DBIx::Class::Validation::Type::object; use strict; use warnings FATAL => 'all'; -use base qw( DBIx::Class::Validation ); use Carp qw( croak ); use DBIx::Class::Field::Type::object; use Class::Std; { - sub validates_roles_of : RESTRICTED method { + sub validates_roles_of : method { my ( $class, $field_name, $roles, $opt ) = @_; $class->_add_object_type_to_field($field_name); @@ -21,7 +20,7 @@ use Class::Std; return; } - sub validates_classes_of : RESTRICTED method { + sub validates_classes_of : method { my ( $class, $field_name, $classes, $opt ) = @_; $class->_add_object_type_to_field($field_name); diff --git a/lib/DBIx/Class/Validation/Type/string.pm b/lib/DBIx/Class/Validation/Type/string.pm index 5b8e696..9fcc9c2 100644 --- a/lib/DBIx/Class/Validation/Type/string.pm +++ b/lib/DBIx/Class/Validation/Type/string.pm @@ -2,12 +2,11 @@ package DBIx::Class::Validation::Type::string; use strict; use warnings FATAL => 'all'; -use base qw( DBIx::Class::Validation ); use Carp qw( croak ); use DBIx::Class::Field::Type::string; use Class::Std; { - sub validates_length_of : RESTRICTED method { + sub validates_length_of : method { my ( $class, $field_name, $opt ) = @_; $class->_add_string_type_to_field($field_name); @@ -29,7 +28,7 @@ use Class::Std; return; } - sub validates_allowed_chars_of : RESTRICTED method { + sub validates_allowed_chars_of : method { my ( $class, $field_name, $allowed_chars, $opt ) = @_; $class->_add_string_type_to_field($field_name); @@ -44,7 +43,7 @@ use Class::Std; return; } - sub validates_disallowed_chars_of : RESTRICTED method { + sub validates_disallowed_chars_of : method { my ( $class, $field_name, $disallowed_chars, $opt ) = @_; $class->_add_string_type_to_field($field_name); @@ -59,7 +58,7 @@ use Class::Std; return; } - sub validates_format_of : RESTRICTED method { + sub validates_format_of : method { my ( $class, $field_name, $format, $opt ) = @_; $class->_add_string_type_to_field($field_name); diff --git a/t/01core.t b/t/01core.t index 5ccdd40..626d27c 100644 --- a/t/01core.t +++ b/t/01core.t @@ -1,10 +1,12 @@ use Test::More; -plan tests => 23; +BEGIN { + plan tests => 23; -use lib qw(t/lib); + use lib qw(t/lib); -use_ok('DBICTest'); + use_ok('DBICTest'); +} my @art = DBICTest::Artist->search({ }, { order_by => 'name DESC'}); diff --git a/t/04db.t b/t/04db.t index 3ab26b7..a1f7b76 100644 --- a/t/04db.t +++ b/t/04db.t @@ -1,10 +1,12 @@ use Test::More; -plan tests => 4; +BEGIN { + plan tests => 4; -use lib qw(t/lib); + use lib qw(t/lib); -use_ok('DBICTest'); + use_ok('DBICTest'); +} # add some rows inside a transaction and commit it # XXX: Is storage->dbh the only way to get a dbh? diff --git a/t/05multipk.t b/t/05multipk.t index e4d364a..474bc52 100644 --- a/t/05multipk.t +++ b/t/05multipk.t @@ -1,10 +1,12 @@ use Test::More; -plan tests => 3; +BEGIN { + plan tests => 3; -use lib qw(t/lib); + use lib qw(t/lib); -use_ok('DBICTest'); + use_ok('DBICTest'); +} ok(DBICTest::FourKeys->find(1,2,3,4), "find multiple pks without hash"); ok(DBICTest::FourKeys->find(5,4,3,6), "find multiple pks without hash"); diff --git a/t/06relationship.t b/t/06relationship.t index ec6b3aa..81c98b3 100644 --- a/t/06relationship.t +++ b/t/06relationship.t @@ -1,10 +1,12 @@ use Test::More; -plan tests => 14; +BEGIN { + plan tests => 14; -use lib qw(t/lib); + use lib qw(t/lib); -use_ok('DBICTest'); + use_ok('DBICTest'); +} # has_a test my $cd = DBICTest::CD->find(4); diff --git a/t/08inflate.t b/t/08inflate.t index 3ecba70..a443210 100644 --- a/t/08inflate.t +++ b/t/08inflate.t @@ -1,13 +1,15 @@ use Test::More; -eval { require DateTime }; -plan skip_all => "Need DateTime for inflation tests" if $@; +BEGIN { + eval { require DateTime }; + plan skip_all => "Need DateTime for inflation tests" if $@; -plan tests => 4; + plan tests => 4; -use lib qw(t/lib); + use lib qw(t/lib); -use_ok('DBICTest'); + use_ok('DBICTest'); +} DBICTest::CD->inflate_column( 'year', { inflate => sub { DateTime->new( year => shift ) }, diff --git a/t/08inflate_has_a.t b/t/08inflate_has_a.t index 80678d1..c392723 100644 --- a/t/08inflate_has_a.t +++ b/t/08inflate_has_a.t @@ -1,13 +1,15 @@ use Test::More; -eval { require DateTime }; -plan skip_all => "Need DateTime for inflation tests" if $@; +BEGIN { + eval { require DateTime }; + plan skip_all => "Need DateTime for inflation tests" if $@; -plan tests => 7; + plan tests => 7; -use lib qw(t/lib); + use lib qw(t/lib); -use_ok('DBICTest'); + use_ok('DBICTest'); +} DBICTest::CD->load_components(qw/CDBICompat::HasA/); diff --git a/t/09update.t b/t/09update.t index 3b4dbe4..ea538aa 100644 --- a/t/09update.t +++ b/t/09update.t @@ -2,13 +2,13 @@ use strict; use Test::More; BEGIN { - eval "use DBD::SQLite"; - plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 4); -} + eval "use DBD::SQLite"; + plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 4); -use lib qw(t/lib); + use lib qw(t/lib); -use_ok('DBICTest'); + use_ok('DBICTest'); +} my $art = DBICTest::Artist->find(1); diff --git a/t/10auto.t b/t/10auto.t index 79d32dc..9033744 100644 --- a/t/10auto.t +++ b/t/10auto.t @@ -1,10 +1,12 @@ use Test::More; -plan tests => 2; +BEGIN { + plan tests => 2; -use lib qw(t/lib); + use lib qw(t/lib); -use_ok('DBICTest'); + use_ok('DBICTest'); +} DBICTest::Artist->load_components(qw/PK::Auto::SQLite/); diff --git a/t/15limit.t b/t/15limit.t index 98fca7a..dda1106 100644 --- a/t/15limit.t +++ b/t/15limit.t @@ -4,11 +4,11 @@ use Test::More; BEGIN { eval "use DBD::SQLite"; plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 10); -} -use lib qw(t/lib); + use lib qw(t/lib); -use_ok('DBICTest'); + use_ok('DBICTest'); +} # test LIMIT my $it = DBICTest::CD->search( {}, diff --git a/t/DBIx/Class/Validation/Type/column/basic.t b/t/DBIx/Class/Validation/Type/column/basic.t index 38aad9c..6cf5155 100644 --- a/t/DBIx/Class/Validation/Type/column/basic.t +++ b/t/DBIx/Class/Validation/Type/column/basic.t @@ -4,7 +4,7 @@ package My::Test; use strict; use warnings FATAL => 'all'; -use Test::More tests => 15; +use Test::More tests => 7; use Test::Exception; use Test::NoWarnings; use base qw(DBIx::Class::Validation); @@ -31,8 +31,6 @@ isa_ok $field, $class .'::Field::id'; SET_FIELD_COMMON: { my %attr = ( column_name => 'Test ID', - deflate => [], - inflate => [], ); while ( my ( $attr, $value ) = each %attr ) { diff --git a/t/cdbi-t/01-columns.t b/t/cdbi-t/01-columns.t index 2bc8573..48abe89 100644 --- a/t/cdbi-t/01-columns.t +++ b/t/cdbi-t/01-columns.t @@ -5,53 +5,55 @@ use Test::More tests => 25; #----------------------------------------------------------------------- # Make sure that we can set up columns properly #----------------------------------------------------------------------- -package State; - -use base 'DBIx::Class'; -State->load_components(qw/CDBICompat Core/); - -State->table('State'); -State->columns(Essential => qw/Abbreviation Name/); -State->columns(Primary => 'Name'); -State->columns(Weather => qw/Rain Snowfall/); -State->columns(Other => qw/Capital Population/); -#State->has_many(cities => "City"); - -sub accessor_name { - my ($class, $column) = @_; - my $return = $column eq "Rain" ? "Rainfall" : $column; - return $return; +BEGIN { + package State; + + use base 'DBIx::Class'; + State->load_components(qw/CDBICompat Core/); + + State->table('State'); + State->columns(Essential => qw/Abbreviation Name/); + State->columns(Primary => 'Name'); + State->columns(Weather => qw/Rain Snowfall/); + State->columns(Other => qw/Capital Population/); + #State->has_many(cities => "City"); + + sub accessor_name { + my ($class, $column) = @_; + my $return = $column eq "Rain" ? "Rainfall" : $column; + return $return; + } + + sub mutator_name { + my ($class, $column) = @_; + my $return = $column eq "Rain" ? "set_Rainfall" : "set_$column"; + return $return; + } + + sub Snowfall { 1 } + + + package City; + + use base 'DBIx::Class'; + City->load_components(qw/CDBICompat Core/); + + City->table('City'); + City->columns(All => qw/Name State Population/); + City->has_a(State => 'State'); + + + #------------------------------------------------------------------------- + package CD; + use base 'DBIx::Class'; + CD->load_components(qw/CDBICompat Core/); + + CD->table('CD'); + CD->columns('All' => qw/artist title length/); + + #------------------------------------------------------------------------- } -sub mutator_name { - my ($class, $column) = @_; - my $return = $column eq "Rain" ? "set_Rainfall" : "set_$column"; - return $return; -} - -sub Snowfall { 1 } - - -package City; - -use base 'DBIx::Class'; -City->load_components(qw/CDBICompat Core/); - -City->table('City'); -City->columns(All => qw/Name State Population/); -City->has_a(State => 'State'); - - -#------------------------------------------------------------------------- -package CD; -use base 'DBIx::Class'; -CD->load_components(qw/CDBICompat Core/); - -CD->table('CD'); -CD->columns('All' => qw/artist title length/); - -#------------------------------------------------------------------------- - package main; is(State->table, 'State', 'State table()'); @@ -116,20 +118,22 @@ ok(!State->find_column('HGLAGAGlAG'), '!find_column HGLAGAGlAG'); #----------------------------------------------------------------------- # Make sure that columns inherit properly #----------------------------------------------------------------------- -package State; - -package A; -@A::ISA = qw(DBIx::Class); -__PACKAGE__->load_components(qw/CDBICompat Core/); -__PACKAGE__->columns(Primary => 'id'); - -package A::B; -@A::B::ISA = 'A'; -__PACKAGE__->columns(All => qw(id b1)); - -package A::C; -@A::C::ISA = 'A'; -__PACKAGE__->columns(All => qw(id c1 c2 c3)); +BEGIN { + package State; + + package A; + @A::ISA = qw(DBIx::Class); + __PACKAGE__->load_components(qw/CDBICompat Core/); + __PACKAGE__->columns(Primary => 'id'); + + package A::B; + @A::B::ISA = 'A'; + __PACKAGE__->columns(All => qw(id b1)); + + package A::C; + @A::C::ISA = 'A'; + __PACKAGE__->columns(All => qw(id c1 c2 c3)); +} package main; is join (' ', sort A->columns), 'id', "A columns"; diff --git a/t/cdbi-t/04-lazy.t b/t/cdbi-t/04-lazy.t index 9db9e27..8072a08 100644 --- a/t/cdbi-t/04-lazy.t +++ b/t/cdbi-t/04-lazy.t @@ -1,5 +1,8 @@ use strict; use Test::More; +use Test::NoWarnings; +use Test::Exception; +use Test::Warn; #---------------------------------------------------------------------- # Test lazy loading @@ -7,7 +10,7 @@ use Test::More; BEGIN { eval "use DBD::SQLite"; - plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 25); + plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 28); } INIT { @@ -58,18 +61,22 @@ ok(!$obj->_attribute_exists('that'), 'nor that'); # Test contructor breaking. -eval { # Need a hashref - Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50); +eval { + Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50) }; ok($@, $@); -eval { # False column - Lazy->create({ this => 10, that => 20, theother => 30 }); -}; -ok($@, $@); -eval { # Multiple false columns - Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 }); -}; +warning_like { + eval { # False column + Lazy->create({ this => 10, that => 20, theother => 30 }); + }; +} qr/table Lazy has no column named theother/; ok($@, $@); +warning_like { + eval { # Multiple false columns + Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 }); + }; +} qr/table Lazy has no column named andanother/; +ok($@, $@); diff --git a/t/cdbi-t/08-inheritcols.t b/t/cdbi-t/08-inheritcols.t index 3e71a9e..f76f8b0 100644 --- a/t/cdbi-t/08-inheritcols.t +++ b/t/cdbi-t/08-inheritcols.t @@ -1,22 +1,25 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 3; +use Test::More tests => 4; +use Test::NoWarnings; use DBIx::Class; -package A; -@A::ISA = qw(DBIx::Class); -__PACKAGE__->load_components(qw/CDBICompat Core/); -__PACKAGE__->columns(Primary => 'id'); - -package A::B; -@A::B::ISA = 'A'; -__PACKAGE__->columns(All => qw(id b1)); - -package A::C; -@A::C::ISA = 'A'; -__PACKAGE__->columns(All => qw(id c1 c2 c3)); +BEGIN { + package A; + @A::ISA = qw(DBIx::Class); + __PACKAGE__->load_components(qw/CDBICompat Core/); + __PACKAGE__->columns(Primary => 'id'); + + package A::B; + @A::B::ISA = 'A'; + __PACKAGE__->columns(All => qw(id b1)); + + package A::C; + @A::C::ISA = 'A'; + __PACKAGE__->columns(All => qw(id c1 c2 c3)); +} package main; is join (' ', sort A->columns), 'id', "A columns"; diff --git a/t/cdbi-t/15-accessor.t b/t/cdbi-t/15-accessor.t index 2f7c85c..04daaf5 100644 --- a/t/cdbi-t/15-accessor.t +++ b/t/cdbi-t/15-accessor.t @@ -1,12 +1,12 @@ use strict; use Test::More; +use Test::NoWarnings; +use Test::Warn; BEGIN { eval "use DBD::SQLite"; - plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 53); -} + plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 55); -INIT { #local $SIG{__WARN__} = #sub { like $_[0], qr/clashes with built-in method/, $_[0] }; use lib 't/testlib'; @@ -14,24 +14,24 @@ INIT { require Actor; Actor->has_a(film => 'Film'); sub Class::DBI::sheep { ok 0; } -} - -sub Film::mutator_name { - my ($class, $col) = @_; - return "set_sheep" if lc $col eq "numexplodingsheep"; - return $col; -} -sub Film::accessor_name { - my ($class, $col) = @_; - return "sheep" if lc $col eq "numexplodingsheep"; - return $col; -} - -sub Actor::accessor_name { - my ($class, $col) = @_; - return "movie" if lc $col eq "film"; - return $col; + sub Film::mutator_name { + my ($class, $col) = @_; + return "set_sheep" if lc $col eq "numexplodingsheep"; + return $col; + } + + sub Film::accessor_name { + my ($class, $col) = @_; + return "sheep" if lc $col eq "numexplodingsheep"; + return $col; + } + + sub Actor::accessor_name { + my ($class, $col) = @_; + return "movie" if lc $col eq "film"; + return $col; + } } my $data = { @@ -56,10 +56,12 @@ eval { }; is $@, '', "No errors"; -eval { - my @film = Film->search({ sheep => 1 }); - is @film, 2, "Can search with modified accessor"; -}; +warning_like { + eval { + my @film = Film->search({ sheep => 1 }); + is @film, 2, "Can search with modified accessor"; + }; +} qr/no such column: sheep/; { diff --git a/t/cdbi-t/16-reserved.t b/t/cdbi-t/16-reserved.t index 7e67411..748f7c9 100644 --- a/t/cdbi-t/16-reserved.t +++ b/t/cdbi-t/16-reserved.t @@ -1,14 +1,15 @@ use strict; use Test::More; +use Test::NoWarnings; BEGIN { eval "use DBD::SQLite"; - plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 5); -} + plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 6); -use lib 't/testlib'; -require Film; -require Order; + use lib 't/testlib'; + use Film; + use Order; +} Film->has_many(orders => 'Order'); Order->has_a(film => 'Film'); diff --git a/t/cdbi-t/98-failure.t b/t/cdbi-t/98-failure.t index fe41b05..e189c35 100644 --- a/t/cdbi-t/98-failure.t +++ b/t/cdbi-t/98-failure.t @@ -1,5 +1,6 @@ use strict; use Test::More; +use Test::NoWarnings; #---------------------------------------------------------------------- # Test database failures @@ -7,7 +8,7 @@ use Test::More; BEGIN { eval "use DBD::SQLite"; - plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 7); + plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 8); } use lib 't/testlib'; @@ -37,7 +38,7 @@ Film->create_test_film; local *DBIx::ContextualFetch::st::execute = sub { die "Database died" }; eval { $btaste->update }; ::like $@, qr/Database died/s, "We failed"; - } + }; $btaste->discard_changes; my $still = Film->retrieve('Bad Taste'); isa_ok $btaste, 'Film', "We still have Bad Taste"; @@ -52,6 +53,11 @@ if (0) { my $sheep = eval { Film->maximum_value_of('numexplodingsheep') }; ::like $@, qr/select.*Database died/s, "Handle database death in single value select"; - } + }; } +$SIG{__WARN__} = sub { + my $warning = shift; + die $warning + if $warning ne "closing dbh with active statement handles\n"; +}; \ No newline at end of file