X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fdeploy_methods%2Fsql_translator.t;h=28f9dda9375161be7529ab76912acbfe34ccbf2a;hb=7877209690a5cc9d34a4a4bc893bf2def787a0ca;hp=4c5a0979cf358c3f4f0714dc99cd0d5cd0403ff3;hpb=58eb99c3f88d8d65151b4b70819037ef13254cbd;p=dbsrgits%2FDBIx-Class-DeploymentHandler.git diff --git a/t/deploy_methods/sql_translator.t b/t/deploy_methods/sql_translator.t index 4c5a097..28f9dda 100644 --- a/t/deploy_methods/sql_translator.t +++ b/t/deploy_methods/sql_translator.t @@ -1,5 +1,8 @@ #!perl +use strict; +use warnings; + use Test::More; use Test::Exception; @@ -9,11 +12,28 @@ use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator'; use File::Spec::Functions; use File::Path qw(rmtree mkpath); -my $db = 'dbi:SQLite:db.db'; -my @connection = ($db, '', '', { ignore_version => 1 }); +my $dbh = DBICDHTest::dbh(); +my @connection = (sub { $dbh }, { ignore_version => 1 }); my $sql_dir = 't/sql'; DBICDHTest::ready; +unlink 'stuffthatran'; + +for (qw(initialize upgrade downgrade deploy)) { + mkpath(catfile(qw( t sql _common), $_, '_any' )); + open my $fh, '>', + catfile(qw( t sql _common), $_, qw(_any 000-win.pl )); + print {$fh} 'sub {open my $fh, ">>", "stuffthatran"; use Data::Dumper::Concise; print {$fh} join(",", @{$_[1]||[]}) . "\n"; }'; + close $fh; +} + +for (qw(initialize upgrade downgrade deploy)) { + mkpath(catfile(qw( t sql SQLite), $_, '_any' )); + open my $fh, '>', + catfile(qw( t sql SQLite), $_, qw(_any 000-win2.pl )); + print {$fh} 'sub {open my $fh, ">>", "stuffthatran"; use Data::Dumper::Concise; print {$fh} join(",", @{$_[1]||[]}) . "\n"; }'; + close $fh; +} VERSION1: { use_ok 'DBICVersion_v1'; @@ -29,21 +49,16 @@ VERSION1: { $dm->prepare_deploy; - mkpath(catfile(qw( t sql SQLite preinstall 1.0 ))); + mkpath(catfile(qw( t sql SQLite initialize 1.0 ))); open my $prerun, '>', - catfile(qw( t sql SQLite preinstall 1.0 003-semiautomatic.pl )); - print {$prerun} "sub {use File::Touch; touch(q(foobar));}"; + catfile(qw( t sql SQLite initialize 1.0 003-semiautomatic.pl )); + print {$prerun} "sub { open my \$fh, '>', q(foobar);}"; close $prerun; - $dm->preinstall({ version => '1.0' }); + $dm->initialize({ version => '1.0' }); - ok -e 'foobar'; + ok -e 'foobar', 'code got run in preinit'; - { - my $warned = 0; - local $SIG{__WARN__} = sub{$warned = 1}; - $dm->prepare_deploy; - ok( $warned, 'prepare_deploy warns if you run it twice' ); - } + dies_ok {$dm->prepare_deploy} 'prepare_deploy dies if you run it twice' ; ok( -f catfile(qw( t sql SQLite deploy 1.0 001-auto.sql )), @@ -78,7 +93,7 @@ VERSION2: { ok( $dm, 'DBIC::DH::SQL::Translator w/2.0 instantiates correctly'); - $version = $s->schema_version(); + my $version = $s->schema_version(); $dm->prepare_deploy; ok( -f catfile(qw( t sql SQLite deploy 2.0 001-auto.sql )), @@ -185,7 +200,7 @@ VERSION3: { ok( $dm, 'DBIC::DH::SQL::Translator w/3.0 instantiates correctly'); - $version = $s->schema_version(); + my $version = $s->schema_version(); $dm->prepare_deploy; ok( -f catfile(qw( t sql SQLite deploy 3.0 001-auto.sql )), @@ -214,16 +229,14 @@ VERSION3: { to_version => $version, version_set => ['2.0', $version] }); - { - my $warned = 0; - local $SIG{__WARN__} = sub{$warned = 1}; + dies_ok { $dm->prepare_upgrade({ from_version => '2.0', to_version => $version, version_set => ['2.0', $version] }); - ok( $warned, 'prepare_upgrade warns if you clobber an existing upgrade file' ); - } + } + 'prepare_upgrade dies if you clobber an existing upgrade file' ; ok( -f catfile(qw( t sql SQLite upgrade 1.0-2.0 001-auto.sql )), '2.0-3.0 diff gets generated properly' @@ -247,5 +260,24 @@ VERSION3: { $dm->upgrade_single_step({ version_set => [qw( 2.0 3.0 )] }); } 'dies when sql dir does not exist'; } + +my $stuff_that_ran = do { local( @ARGV, $/ ) = 'stuffthatran'; <> }; +is $stuff_that_ran, +' + +1.0 +1.0 +1.0,2.0 +1.0,2.0 +2.0,1.0 +2.0,1.0 +1.0,2.0 +1.0,2.0 +2.0,3.0 +2.0,3.0 +2.0,3.0 +2.0,3.0 +', '_any got ran the right amount of times with the right args'; + done_testing; #vim: ts=2 sw=2 expandtab