From: Peter Rabbitson Date: Sun, 17 Jan 2010 21:41:11 +0000 (+0000) Subject: More tets cleanup X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=34963a093bf1e1a2306075d586372607290da7b2;p=dbsrgits%2FDBIx-Class-Historic.git More tets cleanup --- diff --git a/lib/DBIx/Class/Admin.pm b/lib/DBIx/Class/Admin.pm index 43feda6..a8f52ee 100644 --- a/lib/DBIx/Class/Admin.pm +++ b/lib/DBIx/Class/Admin.pm @@ -250,7 +250,7 @@ has config => ( sub _build_config { my ($self) = @_; - try { require 'Config::Any'; } catch { die "Config::Any is required to parse the config file"; }; + try { require Config::Any } catch { die "Config::Any is required to parse the config file"; }; my $cfg = Config::Any->load_files ( {files => [$self->config_file], use_ext =>1, flatten_to_hash=>1}); @@ -411,7 +411,7 @@ sub install { print "retun is $ret\n"; } elsif ($schema->get_db_version() and $self->force ) { - warn "forcing install may not be a good idea"; + warn "Forcing install may not be a good idea"; if($self->_confirm() ) { # FIXME private api $self->schema->_set_db_version({ version => $version}); diff --git a/t/admin/01load.t b/t/admin/01load.t index d91eeed..4f19494 100644 --- a/t/admin/01load.t +++ b/t/admin/01load.t @@ -17,15 +17,7 @@ use strict; use warnings; -use Test::More; # last test to print - -use FindBin qw($Bin); -use Path::Class; - - -use lib dir($Bin,'..', '..','lib')->stringify; -use lib dir($Bin,'..', 'lib')->stringify; - +use Test::More; BEGIN { diff --git a/t/admin/02ddl.t b/t/admin/02ddl.t index df24bad..8191b50 100644 --- a/t/admin/02ddl.t +++ b/t/admin/02ddl.t @@ -17,28 +17,26 @@ use strict; use warnings; -use Test::More; # last test to print - +use Test::More; use Test::Exception; +use Test::Warn; BEGIN { - use FindBin qw($Bin); - use File::Spec::Functions qw(catdir); - use lib catdir($Bin,'..', '..','lib'); - use lib catdir($Bin,'..', 'lib'); - eval "use DBIx::Class::Admin"; plan skip_all => "Deps not installed: $@" if $@; } + +use lib qw(t/lib); +use DBICTest; + use Path::Class; use ok 'DBIx::Class::Admin'; -use DBICTest; -my $sql_dir = dir($Bin,"..","var"); +my $sql_dir = dir(qw/t var/); my @connect_info = DBICTest->_database( no_deploy=>1, no_populate=>1, @@ -92,7 +90,7 @@ require DBICVersionNew; $admin = DBIx::Class::Admin->new( schema_class => 'DBICVersion::Schema', - sql_dir => "t/var", + sql_dir => $sql_dir, connect_info => \@connect_info ); @@ -100,7 +98,10 @@ lives_ok { $admin->create($schema->storage->sqlt_type(), {}, "1.0" ); } 'Can cre # sleep required for upgrade table to hold a distinct time of upgrade value # otherwise the returned of get_db_version can be undeterministic sleep 1; -lives_ok {$admin->upgrade();} 'upgrade the schema'; +{ + local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /DB version .+? is lower than the schema version/ }; + lives_ok {$admin->upgrade();} 'upgrade the schema'; +} is($schema->get_db_version, $DBICVersion::Schema::VERSION, 'Schema and db versions match'); @@ -123,13 +124,15 @@ is($admin->schema->get_db_version, "3.0", 'db thinks its version 3.0'); dies_ok { $admin->install("4.0"); } 'cannot install to allready existing version'; sleep 1; $admin->force(1); -lives_ok { $admin->install("4.0"); } 'can force install to allready existing version'; +warnings_exist ( sub { + lives_ok { $admin->install("4.0") } 'can force install to allready existing version' +}, qr/Forcing install may not be a good idea/, 'Force warning emitted' ); is($admin->schema->get_db_version, "4.0", 'db thinks its version 4.0'); #clean_dir($sql_dir); } sub clean_dir { - my ($dir) =@_; + my ($dir) = @_; $dir = $dir->resolve; if ( ! -d $dir ) { $dir->mkpath();